欢迎来到天天文库
浏览记录
ID:55687888
大小:18.00 KB
页数:3页
时间:2020-05-24
《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
此文档下载收益归作者所有