hiroton
2023/06/19 (月) 18:06:39
81e39@f966d
面白そうなネタだったのでちょっとやってみました
「fFolderPicker」フォームを作成します
ActiveXコントロールから
・「Microsoft TreeView Control, version 6.0」:TreeView
・「Microsoft Forms 2.0 TextBox」:TextBox
を配置します
「TextBox」はWordWrapプロパティを「いいえ」にします
'//標準モジュール:MyFolderPicker
Option Compare Database
Option Explicit
Const defaultPath = "C:"
Public returnString As String
Function folderPicker(Optional folderPath As String)
If folderPath = "" Or Dir(folderPath, vbDirectory) = "" Then folderPath = defaultPath
returnString = ""
DoCmd.OpenForm "fFolderPicker", , , , , acDialog, folderPath
folderPicker = returnString
End Function
'//フォーム:fFolderPicker
Option Compare Database
Option Explicit
Dim fso As Object
Private Sub Form_Close()
Set fso = Nothing
MyFolderPicker.returnString = TreeView.SelectedItem.Key
End Sub
Private Sub Form_Load()
Dim folderPath As String
Dim folderName As String
folderPath = OpenArgs
folderName = Mid(OpenArgs, InStrRev(OpenArgs, "\") + 1)
Set fso = CreateObject("Scripting.FileSystemObject")
TreeView.Nodes.Add , , folderPath, folderName
TreeView_NodeClick TreeView.Nodes(1)
End Sub
Private Sub TreeView_NodeClick(ByVal Node As Object)
Dim files As String
Dim file As Object
For Each file In fso.GetFolder(Node.Key).files
files = files & file.Name & vbCrLf
Next
Me.TextBox.Value = files
If Node.Tag = "Done" Then Exit Sub
Dim folder As Object
For Each folder In fso.GetFolder(Node.Key).SubFolders
TreeView.Nodes.Add Node.Key, tvwChild, folder.path, folder.Name
Next
Node.Tag = "Done"
Node.Expanded = True
End Sub
手を抜けそうなところは抜きつつ、ですが、このあと、ダイアログとしての体裁を整えるのにさらに苦労することはまた別の話
通報 ...