📄 frmexcel1.frm
字号:
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 336
Left = 1755
MaskColor = &H00000000&
TabIndex = 18
Top = 495
Width = 576
End
Begin VB.ListBox lstSelected
ForeColor = &H000000FF&
Height = 1320
Left = 2550
Style = 1 'Checkbox
TabIndex = 17
Top = 495
Width = 2220
End
Begin VB.ListBox lstAll
ForeColor = &H000000FF&
Height = 1320
ItemData = "FRMEXCEL1.frx":0DC6
Left = 180
List = "FRMEXCEL1.frx":0DC8
TabIndex = 16
Top = 495
Width = 1290
End
Begin ACTIVESKINLibCtl.SkinLabel SkinLabel3
Height = 255
Index = 10
Left = 2490
OleObjectBlob = "FRMEXCEL1.frx":0DCA
TabIndex = 24
Top = 210
Width = 2415
End
Begin ACTIVESKINLibCtl.SkinLabel SkinLabel3
Height = 255
Index = 11
Left = 180
OleObjectBlob = "FRMEXCEL1.frx":0E39
TabIndex = 25
Top = 240
Width = 1305
End
End
Begin VB.Frame Frame4
Caption = "对应字段选择"
Height = 2235
Left = 60
TabIndex = 4
Top = 2700
Width = 5505
Begin VB.CommandButton Down
Caption = "↓"
Height = 435
Left = 4920
Picture = "FRMEXCEL1.frx":0E98
TabIndex = 12
Top = 1380
Width = 435
End
Begin VB.CommandButton Up
Caption = "↑"
Height = 435
Left = 4920
Picture = "FRMEXCEL1.frx":0F9A
TabIndex = 11
Top = 690
Width = 435
End
Begin VB.CommandButton LeftAll
Caption = "<<"
BeginProperty Font
Name = "宋体"
Size = 9.75
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 336
Left = 1785
MaskColor = &H00000000&
TabIndex = 10
Top = 1680
Width = 576
End
Begin VB.CommandButton LeftOne
Caption = "<"
BeginProperty Font
Name = "宋体"
Size = 9.75
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 336
Left = 1785
MaskColor = &H00000000&
TabIndex = 9
Top = 1305
Width = 576
End
Begin VB.CommandButton RightAll
Caption = ">>"
BeginProperty Font
Name = "宋体"
Size = 9.75
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 336
Left = 1785
MaskColor = &H00000000&
TabIndex = 8
Top = 930
Width = 576
End
Begin VB.CommandButton One
Caption = ">"
BeginProperty Font
Name = "宋体"
Size = 9.75
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 336
Left = 1785
MaskColor = &H00000000&
TabIndex = 7
Top = 555
Width = 576
End
Begin VB.ListBox LIST2
ForeColor = &H00FF0000&
Height = 1320
Left = 2580
Style = 1 'Checkbox
TabIndex = 6
Top = 480
Width = 2220
End
Begin VB.ListBox List1
ForeColor = &H00FF0000&
Height = 1320
ItemData = "FRMEXCEL1.frx":109C
Left = 180
List = "FRMEXCEL1.frx":10A3
TabIndex = 5
Top = 540
Width = 1350
End
Begin ACTIVESKINLibCtl.SkinLabel SkinLabel3
Height = 255
Index = 12
Left = 210
OleObjectBlob = "FRMEXCEL1.frx":10AE
TabIndex = 13
Top = 270
Width = 1305
End
Begin ACTIVESKINLibCtl.SkinLabel SkinLabel3
Height = 255
Index = 9
Left = 2520
OleObjectBlob = "FRMEXCEL1.frx":110D
TabIndex = 14
Top = 210
Width = 2475
End
End
Begin VB.CommandButton Command3
Caption = "Command3"
Height = 345
Left = 420
TabIndex = 3
Top = 7440
Visible = 0 'False
Width = 975
End
Begin VB.CommandButton Command4
Caption = "Command4"
Height = 315
Left = 360
TabIndex = 2
Top = 8190
Visible = 0 'False
Width = 825
End
Begin VB.TextBox Text1
Height = 1995
Left = 930
MultiLine = -1 'True
ScrollBars = 2 'Vertical
TabIndex = 1
Text = "FRMEXCEL1.frx":117C
Top = 7950
Visible = 0 'False
Width = 8715
End
Begin VB.CommandButton Command5
Caption = "退出程序"
Height = 615
Left = 7500
TabIndex = 0
Top = 4320
Width = 1275
End
Begin ACTIVESKINLibCtl.Skin Skin1
Left = 5880
OleObjectBlob = "FRMEXCEL1.frx":1182
Top = 3300
End
Begin ACTIVESKINLibCtl.SkinLabel SkinLabel3
Height = 375
Index = 4
Left = 5760
OleObjectBlob = "FRMEXCEL1.frx":4B671
TabIndex = 50
Top = 2460
Width = 3135
End
Begin ACTIVESKINLibCtl.SkinLabel SkinLabel3
Height = 255
Index = 13
Left = 60
OleObjectBlob = "FRMEXCEL1.frx":4B6F6
TabIndex = 51
Top = 2460
Width = 5535
End
End
Attribute VB_Name = "FRMEXCEL1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim fd As Field
Dim astr As String
Dim dbAdd As Database
Dim db As Database
Dim GYXE As String
Dim rs As Recordset
Dim NUM As Long
Dim FU As Long
Dim STR As String
Dim lssel As String
Dim lssela As String
Private Sub Command1_Click()
On Error Resume Next
Combo1.Clear
Combo4.Clear
Combo2.Clear
Combo3.Clear
Combo1.AddItem "不导入"
Combo2.AddItem "不导入"
Combo3.AddItem "不导入"
Combo4.AddItem "不导入"
Combo6.AddItem "不导入"
Combo7.AddItem "不导入"
Combo9.AddItem "不导入"
Combo11.AddItem "不导入"
List1.Clear
Dim db As DAO.Database
Dim oTD As DAO.TableDef
Dim f As DAO.Field
Set db = Workspaces(0).OpenDatabase(App.Path & "\TEMP\" & DD & ".NHB")
Set oTD = db.TableDefs("EXCLE")
With oTD
lCount = .Fields.Count
For lCtr = 0 To lCount - 1
Combo1.AddItem oTD.Fields(lCtr).Name
Combo2.AddItem oTD.Fields(lCtr).Name
Combo3.AddItem oTD.Fields(lCtr).Name
Combo4.AddItem oTD.Fields(lCtr).Name
Combo6.AddItem oTD.Fields(lCtr).Name
Combo7.AddItem oTD.Fields(lCtr).Name
Combo9.AddItem oTD.Fields(lCtr).Name
List1.AddItem oTD.Fields(lCtr).Name
Next
End With
db.Close
Set db = DBEngine.Workspaces(0).OpenDatabase(App.Path & "\TEMP\" & DD & ".NHB")
astr = "ALTER TABLE EXCLE ADD COLUMN 不导入 TEXT(15)"
db.Execute astr
Set db = DBEngine.Workspaces(0).OpenDatabase(App.Path & "\TEMP\" & DD & ".NHB")
db.Execute "UPDATE EXCLE SET 不导入=''"
db.Close
Combo1.ListIndex = 0
Combo2.ListIndex = 0
Combo3.ListIndex = 0
Combo4.ListIndex = 0
Combo6.ListIndex = 0
Combo7.ListIndex = 0
Combo9.ListIndex = 0
Combo11.ListIndex = 0
List1.ListIndex = 0
End Sub
Private Sub Command2_Click()
On Error GoTo 3061
Call Command3_Click
Call Command4_Click
' MsgBox "自动导入操作前,程序将删除当前所有已录入的数据！！！", vbOKOnly, "警告！"
Set db = OpenDatabase(App.Path & "\TEMP\" & DD & ".NHB")
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -