[已解决]怎样让TreeView显示当前文件夹内数据库表名

wsq7668

请各位大侠帮忙！附件文件夹内有个数据源文件夹，数据源文件夹内由若干个数据库，打开窗体后TreeView显示所有数据库名，请问怎样让所有数据库父目录下显示数据库内的所有表名作为子目录。谢谢！ 显示数据库表名.rar (40.86 KB, 下载次数: 15)

2013-2-5 09:17 上传

点击文件名下载附件

最佳答案

月排行榜 / 总排行榜

hwc2ycy

2013-2-5 11:18

1. Function getAccessTable(ByVal fullname As String)
   
2.     Dim filename$
   
3.     Dim Path$
   
4.     Dim access As Object, tb As Object
   
5.     Dim i As Byte
   
6.     Dim arr() As String
   
7.     Set access = CreateObject("access.Application")
   
8.     access.OpenCurrentDatabase fullname
   
9.     For Each tb In access.CurrentData.AllTables
   
10.         If Not tb.Name Like "MSys*" Then
    
11.             i = i + 1
    
12.             ReDim Preserve arr(1 To i)
    
13.             arr(i) = tb.Name
    
14.         End If
    
15.     Next
    
16.     access.CloseCurrentDatabase
    
17.     access.Quit 2
    
18.     If i > 0 Then
    
19.         getAccessTable = arr
    
20.     Else
    
21.         getAccessTable = False
    
22.     End If
    
23. End Function
    
24. 
    
25. Sub tset()
    
26.     Dim arr
    
27.     arr = getAccessTable(ThisWorkbook.Path & "\数据一.mdb")
    
28.     Stop
    
29. End Sub

复制代码

做成函数。
如果指定的MDB里有表的话，会把所有的名字放在一个数组里返回，否则返回FALSE。
数组下边界是从1开始。

跳转到最佳答案楼层

hwc2ycy

你把上次做的再改进下，加入工作表的部分代码就可以了。

wsq7668

不懂这个，上次那个我没打开，麻烦您在这个附件里写下好吗！谢谢！

hwc2ycy

我在EXCEL里写个成不？
ACCESS的还不太会。
窗体也没找到。

wsq7668

我的只显示数据库名，但是子目录表名不知道如何显示，数据库名显示代码，Dim CunZai As Boolean '定义变量
Dim fso As New Scripting.FileSystemObject, i
Dim sFolder As Scripting.Folder
Dim sFolder_1 As Scripting.Folder
Dim FileName As String, myName As String '显示文件夹
Set sFolder = fso.GetFolder(App.Path) '
For Each sFolder_1 In sFolder.SubFolders
Next '显示文件
FileName = App.Path & "\数据源\"
myName = Dir(FileName)
Do While myName <> ""
TreeView1.Nodes.Add.Text = myName
myName = Dir
Loop

hwc2ycy

1. Sub TEST()
   
2.     Dim filename$
   
3.     Dim Path$
   
4.     Dim access As Object, tb As Object
   
5.     Path = ThisWorkbook.Path & Application.PathSeparator
   
6.     Set access = CreateObject("access.Application")
   
7.     filename = Dir(Path & "*.mdb")
   
8. 
   
9.     Do While Len(filename)
   
10.         access.OpenCurrentDatabase Path & filename
    
11.         Debug.Print filename
    
12.         For Each tb In access.CurrentData.AllTables
    
13.             If Not tb.Name Like "MSys*" Then Debug.Print tb.Name
    
14.         Next
    
15. 
    
16.         access.CloseCurrentDatabase
    
17.         filename = Dir
    
18.     Loop
    
19.     access.Quit 2
    
20. End Sub

复制代码

查帮助写的。
你可以参考下。

wsq7668

先谢谢您解答！我来试下！

hwc2ycy

1. Function getAccessTable(ByVal fullname As String)
   
2.     Dim filename$
   
3.     Dim Path$
   
4.     Dim access As Object, tb As Object
   
5.     Dim i As Byte
   
6.     Dim arr() As String
   
7.     Set access = CreateObject("access.Application")
   
8.     access.OpenCurrentDatabase fullname
   
9.     For Each tb In access.CurrentData.AllTables
   
10.         If Not tb.Name Like "MSys*" Then
    
11.             i = i + 1
    
12.             ReDim Preserve arr(1 To i)
    
13.             arr(i) = tb.Name
    
14.         End If
    
15.     Next
    
16.     access.CloseCurrentDatabase
    
17.     access.Quit 2
    
18.     If i > 0 Then
    
19.         getAccessTable = arr
    
20.     Else
    
21.         getAccessTable = False
    
22.     End If
    
23. End Function
    
24. 
    
25. Sub tset()
    
26.     Dim arr
    
27.     arr = getAccessTable(ThisWorkbook.Path & "\数据一.mdb")
    
28.     Stop
    
29. End Sub

复制代码

做成函数。
如果指定的MDB里有表的话，会把所有的名字放在一个数组里返回，否则返回FALSE。
数组下边界是从1开始。

hwc2ycy

暂时没有针对报错做处理，第一次接触ACCESS VBA。
所以要查找时，请注意不要针对已经打开的MDB文件做查询。