用vba选择文件夹

MIKE888

学习中

hacker85

先看一下再收藏，看看有什么不能同之处

exceljyf

用了第二种方法，谢谢楼主！！

yf_992258

不知是否楼上要的

abzzl

怎么样自动填充一个文件夹里的文件名到EXCEL表里？我要统计学生的作业

lzyamo3057

收藏了，谢谢分享

香川群子

Public FilePath As String
Public SubDir As Boolean
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
Function BrowseDir() As String
    Dim iFolder As FolderInfor
    Dim pidl As Long, Flag As Long, iPath As String, Pos As Integer, myPath As String
    EnableWindow FindWindow("XLMAIN", Application.Caption), False
    pidl& = SHBrowseForFolder(iFolder)
    EnableWindow FindWindow("XLMAIN", Application.Caption), True
    iPath = Space$(512)
    Flag = SHGetPathFromIDList(ByVal pidl, ByVal iPath)
    If Flag Then
        Pos = InStr(iPath, Chr$(0))
        BrowseDir = Left(iPath, Pos - 1)
    Else
        BrowseDir = ""
    End If
End Function

sanguteduo

API就是选文件夹麻烦点

cnjleung

学习了，谢谢楼主。

zeuyie

恩，是一个不错的方法