AutoCAD VBA选择文件夹的代码.doc

《AutoCAD VBA选择文件夹的代码.doc》由会员上传分享，免费在线阅读，更多相关内容在行业资料-天天文库。

1、'AutoCADVBA选择文件夹的代码'流沙之泉编写于2018年11月30日，于AutoCAD201764位上测试通过。'将此份文档另存为纯文本格式文件MdFileBrw.bas，'并导入至vba的模块中即可在其他模块调用当中的函数。'其中GetFolder函数可以选择文件夹并返回选择的路径（按取消则返回空字符串），'ListFilesFSO过程可以根据传入的文件夹路径在调试输出窗口输出文件名，不含子文件夹。AttributeVB_Name="MdFileBrw"OptionExplicit'*************系统类型与函数声明开始***************PublicTy

2、peBROWSEINFOhOwnerAsLongPtrpidlRootAsLongPtrpszDisplayNameAsStringlpszTitleAsStringulFlagsAsLongPtrlpfnAsLongPtrlParamAsLongPtriImageAsLongPtrEndTypePublicConstBIF_RETURNONLYFSDIRS=&H1PublicConstBIF_DONTGOBELOWDOMAIN=&H2PublicConstBIF_STATUSTEXT=&H4PublicConstBIF_RETURNFSANCESTORS=&H8PublicConst

3、BIF_BROWSEFORCOMPUTER=&H1000PublicConstBIF_BROWSEFORPRINTER=&H2000PublicConstBIF_NEWDIALOGSTYLE=&H40DeclarePtrSafeFunctionSHGetPathFromIDListLib"shell32.dll"Alias"SHGetPathFromIDListA"(ByValpidlAsLongPtr,ByValpszPathAsString)AsLongPtrDeclarePtrSafeFunctionSHBrowseForFolderLib"shell32.dll"Alias"S

4、HBrowseForFolderA"(lpBrowseInfoAsBROWSEINFO)AsLongPtr'*************系统类型与函数声明结束***************'此函数返回确保后面带反斜杠的文件路径PublicFunctionEnsurePath(ByValsPathAsString)AsStringIfRight(sPath,1)<>""ThenEnsurePath=sPath&""ElseEnsurePath=sPathEndIfEndFunction'主函数，参数为选择文件夹对话框里的提醒文字PublicFunctionGetFolder(ByVal

5、sTitleAsString)AsStringDimbInfAsBROWSEINFODimretvalAsLongPtrDimPathIDAsLongPtrDimRetPathAsStringDimOffsetAsIntegerbInf.lpszTitle=sTitlebInf.ulFlags=BIF_NEWDIALOGSTYLEPathID=SHBrowseForFolder(bInf)RetPath=Space$(512)retval=SHGetPathFromIDList(ByValPathID,ByValRetPath)IfretvalThenOffset=InStr(RetP

6、ath,Chr$(0))GetFolder=Left$(RetPath,Offset-1)EndIfEndFunctionPublicSubListFilesFSO(ByValsPathAsString)DimoFSOAsObjectDimoFolderAsObjectDimoFileAsObjectSetoFSO=CreateObject("Scripting.FileSystemObject")SetoFolder=oFSO.GetFolder(sPath)ForEachoFileInoFolder.FilesDebug.PrintoFile.NameNext'oFileSetoF

7、ile=NothingSetoFolder=NothingSetoFSO=NothingEndSub