📄 form1.frm
字号:
VERSION 5.00
Begin VB.Form Form1
Caption = "获取硬盘文件到数据库"
ClientHeight = 2655
ClientLeft = 60
ClientTop = 345
ClientWidth = 4065
LinkTopic = "Form1"
ScaleHeight = 2655
ScaleWidth = 4065
StartUpPosition = 1 '所有者中心
Begin VB.FileListBox File1
Height = 630
Left = 180
TabIndex = 4
Top = 1995
Width = 2625
End
Begin VB.CommandButton Command1
Caption = "获取"
Height = 540
Left = 2940
TabIndex = 3
Top = 1500
Width = 1020
End
Begin VB.CommandButton Command2
Caption = "退出"
Height = 540
Left = 2940
TabIndex = 2
Top = 2070
Width = 1020
End
Begin VB.DirListBox Dir1
Height = 1350
Left = 195
TabIndex = 1
TabStop = 0 'False
Top = 555
Width = 2600
End
Begin VB.DriveListBox Drive1
Height = 300
Left = 195
TabIndex = 0
Top = 195
Width = 2600
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub Form_Load()
Drive1.Drive = "c:"
End Sub
Private Sub Command1_Click()
Dim i As Integer
Dim j As Integer
Dim a As String
Dim b As String
Dim mydb1 As Database
Dim myrs1 As Recordset
Set mydb1 = Workspaces(0).OpenDatabase(App.Path & "\path.mdb") '打开数据库
Set myrs1 = mydb1.OpenRecordset("path", dbOpenTable) '打开记录集
If Dir1.ListCount > -1 Then
For i = 1 To Dir1.ListCount '选择第一级文件夹
Dir1.ListIndex = i - 1
a = File1.Path
Dir1.Path = Dir1.List(i - 1)
myrs1.AddNew
myrs1.Fields(1) = File1.Path '添加文件夹(含路经)
myrs1.Fields(0) = Right(File1.Path, (InStr(StrReverse(File1.Path), "\")) - 1) '添加文件夹
myrs1.Update
If Dir1.ListCount > -1 Then
For j = 0 To Dir1.ListCount - 1 '选择第二级文件夹
b = Dir1.Path
Dir1.ListIndex = j
Dir1.Path = Dir1.List(j)
myrs1.AddNew
myrs1.Fields(2) = File1.Path '添加文件夹(含路经)
myrs1.Fields(0) = Right(File1.Path, (InStr(StrReverse(File1.Path), "\")) - 1) '添加文件夹
myrs1.Update
If Dir1.ListCount > -1 Then
For K = 0 To Dir1.ListCount - 1 '选择第三级文件夹
C = Dir1.Path
Dir1.ListIndex = K
Dir1.Path = Dir1.List(K)
myrs1.AddNew
myrs1.Fields(3) = File1.Path '添加文件夹(含路经)
myrs1.Fields(0) = Right(File1.Path, (InStr(StrReverse(File1.Path), "\")) - 1) '添加文件夹
myrs1.Update
Dir1.Path = C
Next K
End If
Dir1.Path = b
Next j
End If
Dir1.Path = a
Next i
End If
End Sub
Private Sub Dir1_Change()
File1.Path = Dir1.Path
End Sub
Private Sub Drive1_Change()
Dir1.Path = Drive1.Drive
End Sub
Private Sub Command2_Click()
End
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -