AutoCAD VBA選擇文件夾的代碼

AutoCAD VBA選擇文件夾的代碼流沙之泉編寫于2018年11月30日，于AutoCAD2017 64位上測試通過。將此份文檔另存為純文本格式文件MdFileBrw.bas，并導(dǎo)入至vba的模塊中即可在其他模塊調(diào)用當(dāng)中的函數(shù)。其中GetFolder函數(shù)可以選擇文件夾并返回選擇的路徑（按取消則返回空字符串），ListFilesFSO過程可以根據(jù)傳入的文件夾路徑在調(diào)試輸出窗口輸出文件名，不含子文件夾。Attribute VB_Name = MdFileBrwOption Explicit*系統(tǒng)類型與函數(shù)聲明開始*Public Type BROWSEINFO hOwner As LongPtr pidlRoot As LongPtr pszDisplayName As String lpszTitle As String ulFlags As LongPtr lpfn As LongPtr lParam As LongPtr iImage As LongPtrEnd TypePublic Const BIF_RETURNONLYFSDIRS = &H1Public Const BIF_DONTGOBELOWDOMAIN = &H2Public Const BIF_STATUSTEXT = &H4Public Const BIF_RETURNFSANCESTORS = &H8Public Const BIF_BROWSEFORCOMPUTER = &H1000Public Const BIF_BROWSEFORPRINTER = &H2000Public Const BIF_NEWDIALOGSTYLE = &H40Declare PtrSafe Function SHGetPathFromIDList Lib shell32.dll Alias SHGetPathFromIDListA (ByVal pidl As LongPtr, ByVal pszPath As String) As LongPtrDeclare PtrSafe Function SHBrowseForFolder Lib shell32.dll Alias SHBrowseForFolderA (lpBrowseInfo As BROWSEINFO) As LongPtr*系統(tǒng)類型與函數(shù)聲明結(jié)束*此函數(shù)返回確保后面帶反斜杠的文件路徑Public Function EnsurePath(ByVal sPath As String) As String If Right(sPath, 1) Then EnsurePath = sPath & Else EnsurePath = sPath End IfEnd Function主函數(shù)，參數(shù)為選擇文件夾對(duì)話框里的提醒文字Public Function GetFolder(ByVal sTitle As String) As String Dim bInf As BROWSEINFO Dim retval As LongPtr Dim PathID As LongPtr Dim RetPath As String Dim Offset As Integer bInf.lpszTitle = sTitle bInf.ulFlags = BIF_NEWDIALOGSTYLE PathID = SHBrowseForFolder(bInf) RetPath = Space$(512) retval = SHGetPathFromIDList(ByVal PathID, ByVal RetPath) If retval Then Offset = InStr(RetPath, Chr$(0) GetFolder = Left$(RetPath, Offset - 1) End IfEnd FunctionPublic Sub ListFilesFSO(ByVal sPath As String) Dim oFSO As Object Dim oFolder As Object Dim oFile As Object Set oFSO = CreateObject(Scripting.FileSystemObject) Set oFolder = oFSO.GetFolder(sPath) For Each oFile In oFolder.Files Deb