📄 transfer.frm
字号:
VERSION 5.00
Begin VB.Form transfer
BorderStyle = 3 'Fixed Dialog
Caption = "数据转换工具"
ClientHeight = 5250
ClientLeft = 5355
ClientTop = 3165
ClientWidth = 4440
Icon = "transfer.frx":0000
LinkTopic = "Form3"
LockControls = -1 'True
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 5250
ScaleWidth = 4440
ShowInTaskbar = 0 'False
StartUpPosition = 2 '屏幕中心
Begin VB.Data Data1
Caption = "Data1"
Connect = "Access"
DatabaseName = ""
DefaultCursorType= 0 '缺省游标
DefaultType = 2 '使用 ODBC
Exclusive = 0 'False
Height = 345
Left = 720
Options = 0
ReadOnly = 0 'False
RecordsetType = 1 'Dynaset
RecordSource = ""
Top = 7080
Visible = 0 'False
Width = 1140
End
Begin VB.Frame Frame1
Caption = "数据表导出到Excel"
Height = 2535
Left = 120
TabIndex = 9
Top = 120
Width = 4215
Begin VB.Timer Timer1
Interval = 1
Left = 3120
Top = 0
End
Begin VB.TextBox Text3
Appearance = 0 'Flat
BackColor = &H80000018&
Height = 300
Left = 720
TabIndex = 14
Top = 120
Visible = 0 'False
Width = 1935
End
Begin VB.CommandButton Command4
Caption = "查询数据信息"
Enabled = 0 'False
Height = 375
Left = 2760
MouseIcon = "transfer.frx":08CA
MousePointer = 99 'Custom
TabIndex = 13
Top = 2040
Width = 1335
End
Begin VB.CommandButton Command2
BackColor = &H00FFFFFF&
Caption = "ACCESS转成EXCEL"
Height = 375
Left = 2760
MouseIcon = "transfer.frx":0A1C
MousePointer = 99 'Custom
TabIndex = 12
Top = 1260
Width = 1335
End
Begin VB.ListBox List1
BackColor = &H80000018&
Enabled = 0 'False
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 1950
Left = 120
MouseIcon = "transfer.frx":0B6E
MousePointer = 99 'Custom
TabIndex = 11
Top = 480
Width = 2535
End
Begin VB.CommandButton Command1
Caption = "打开数据库"
Height = 375
Left = 2760
MouseIcon = "transfer.frx":0CC0
MousePointer = 99 'Custom
TabIndex = 10
Top = 480
Width = 1335
End
Begin VB.Label Label4
AutoSize = -1 'True
Caption = "数据表："
Height = 180
Left = 120
TabIndex = 15
Top = 240
Width = 720
End
End
Begin VB.Frame Frame2
Caption = "Excel导入数据库"
Height = 2535
Left = 120
TabIndex = 0
Top = 2640
Width = 4215
Begin VB.CommandButton Command6
Caption = "打开Excel"
Height = 375
Left = 2760
MouseIcon = "transfer.frx":0E12
MousePointer = 99 'Custom
TabIndex = 16
Top = 360
Width = 1335
End
Begin VB.TextBox Text2
Appearance = 0 'Flat
BackColor = &H80000018&
Height = 300
Left = 1080
TabIndex = 5
Top = 2040
Width = 1575
End
Begin VB.TextBox Text1
Appearance = 0 'Flat
BackColor = &H80000018&
Height = 300
Left = 1080
TabIndex = 4
Top = 1680
Width = 1575
End
Begin VB.CommandButton Command3
BackColor = &H00C0FFFF&
Caption = "EXCEL转成ACCESS"
Height = 375
Left = 2760
MouseIcon = "transfer.frx":0F64
MousePointer = 99 'Custom
TabIndex = 3
Top = 1200
Width = 1335
End
Begin VB.CommandButton Command5
BackColor = &H00C0FFFF&
Caption = "处理结束"
Height = 375
Left = 2760
MouseIcon = "transfer.frx":10B6
MousePointer = 99 'Custom
TabIndex = 2
Top = 1920
Width = 1335
End
Begin VB.FileListBox File1
BackColor = &H80000018&
Enabled = 0 'False
Height = 630
Left = 120
TabIndex = 1
Top = 840
Width = 2535
End
Begin VB.Label Label5
Caption = "单击选择要转换的Excel文件，然后在输入表名的格中输入要转换成的数据表的名称："
Height = 615
Left = 120
TabIndex = 8
Top = 240
Width = 2655
End
Begin VB.Label Label6
Caption = "Excel名："
Height = 375
Left = 210
TabIndex = 7
Top = 1680
Width = 855
End
Begin VB.Label Label7
Caption = "输入表名："
Height = 375
Left = 120
TabIndex = 6
Top = 2040
Width = 975
End
End
End
Attribute VB_Name = "transfer"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim db As Database
Dim tbl As TableDef
Private Sub Command1_Click()
List1.Enabled = True
Text3.Text = App.Path & "\xs.mdb"
List1.Clear
Set db = DBEngine.Workspaces(0).OpenDatabase(Text3.Text)
For Each tbl In db.TableDefs
If Left(tbl.Name, 4) <> "MSys" And Left(tbl.Name, 4) <> "USys" Then
List1.AddItem tbl.Name
End If
Next
If List1.ListCount > 0 Then
List1.ListIndex = 0
dbfn = Text3.Text
End If
End Sub
Private Sub Command2_Click()
Dim dbs As Database
Set dbs = OpenDatabase(App.Path & "\xs.mdb")
If Dir(App.Path & "\" & "excel" & "\" & Trim(List1.Text) & ".xls") <> "" Then Kill App.Path & "\" & Trim(List1.Text) & ".xls"
dbs.Execute "SELECT * INTO [Excel 8.0;DATABASE=" & App.Path & "\" & "excel" & "\" & Trim(List1.Text) & ".xls].[WorkSheet1] FROM [" & Trim(List1.Text) & "] "
dbs.Close
Set dbs = Nothing
MsgBox ("数据转换成功!")
End Sub
Private Sub Command3_Click()
Dim dbs As Database
Set dbs = OpenDatabase(App.Path & "\xs.mdb")
On Error Resume Next
dbs.Execute "DROP TABLE [" & Trim(Text2.Text) & "];"
dbs.Execute "SELECT * INTO [" & Trim(Text2.Text) & "] FROM [Excel 8.0;DATABASE=" & App.Path & "\" & "excel" & "\" & Trim(Text1.Text) & "].[WorkSheet1] "
dbs.Close
Set dbs = Nothing
MsgBox ("数据转换成功!")
End Sub
Private Sub Command4_Click()
mdbf.Show
End Sub
Private Sub Command5_Click()
For i = 1 To Me.Height / 2
Me.Height = Me.Height - 30
Next i
horiz:
Me.Height = 30
gotoval = Me.Height
For gointi = 1 To gotoval
DoEvents
Me.Width = Me.Width - 30
If Me.Width <= 11 Then End
Next gointi
Unload Me
End Sub
Private Sub Command6_Click()
File1.Enabled = True
File1.Path = App.Path & "\" & "excel"
File1.Pattern = "*.xls"
End Sub
Private Sub File1_Click()
Text1.Text = File1.FileName
End Sub
Private Sub Form_Load()
frmMain.Enabled = True
End Sub
Private Sub Form_Unload(Cancel As Integer)
frmMain.Enabled = True
End Sub
Private Sub List1_Click()
If List1.Text <> "" Then
Command4.Enabled = True
tbfn = List1.Text
End If
End Sub
Private Sub Timer1_Timer()
Me.Refresh
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -