Question

VBA里如何调用目录对话框并取得路径

Answer 1

给你一个现成的，你只需拷贝到你的宏里去使用；
Sub 查找文件夹下子文件夹及其大小()
Dim theDir As String

Set pt = ActiveSheet.Range("a1")
pt.Worksheet.Columns(1).ClearContents
theDir = Application.InputBox("输入指定文件夹的路径：", "查看子文件夹及其大小")
pt = theDir
listPath theDir

pt.Worksheet.Columns("a:b").AutoFit
End Sub

Sub listPath(strDir As String)
Dim thePath As String
Dim strSdir As String
Dim theDirs As Scripting.Folders
Dim theDir As Scripting.Folder
Dim row As Integer
Dim s As String
Dim myFso As Scripting.FileSystemObject

Set myFso = New Scripting.FileSystemObject
If Right(strDir, 1) <> "\" Then strDir = strDir & "\"
thePath = thePath & strDir

row = pt.row '此段为获取此目录下的文件名
s = Dir(thePath, 7) '获取第一个文件
Do While s <> ""
row = row + 1
Cells(row, 1) = s '文件的名称
Cells(row, 1).Font.Color = RGB(256, 12, 213)
Cells(row, 1).Font.Bold = Ture
s = Dir
Loop
Set pt = Cells(row, 1)
Set pt = pt.Offset(1, 0)
Set theDirs = myFso.getfolder(strDir).subfolders '取得所有子文件
For Each theDir In theDirs
pt = theDir.Path
pt.Next = theDir.Size
listPath theDir.Path
Next

Set myFso = Nothing
End Sub

Private Sub CommandButton1_Click()
查找文件夹下子文件夹及其大小
End Sub

Answer 2

'声明API函数
Declare Function SHBrowseForFolder Lib "shell32.dll" Alias "SHBrowseForFolderA" (lpBrowseInfo As FolderInfor) As Long
Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function EnableWindow Lib "user32" (ByVal hWnd As Long, ByVal fEnable As Long) As Long
'定义变量类型
Public Type FolderInfor
hOwner As Long
pidlRoot As Long
pszDisplayName As String
lpszTitle As String
ulFlags As Long
lpfn As Long
lParam As Long
iImage As Long
End Type
Sub BrowDir()
Dim iFolder As FolderInfor
Dim pidl As Long, Flag As Long, iPath As String, Pos As Integer, myPath As String
'FindWindow取得Excel窗口的句柄
'在Excel窗口里禁止所有鼠标及键盘输入
EnableWindow FindWindow("XLMAIN", Application.Caption), False
'显示目录选择对话框
pidl = SHBrowseForFolder(iFolder)
'在Excel窗口里允许鼠标及键盘输入
EnableWindow FindWindow("XLMAIN", Application.Caption), True
iPath = Space$(512)
Flag = SHGetPathFromIDList(ByVal pidl, ByVal iPath)
If Flag Then
Pos = InStr(iPath, Chr$(0))
'取得选择的目录
myPath = Left(iPath, Pos - 1)
End If
MsgBox "你选择了 " & myPath
End Sub

Answer 3

Option Explicit

Sub test()
MsgBox Application.ActiveWorkbook.Path
End Sub