社区 › VBA/VB/ActiveX/API 编程技术 › [求助]关于cad文件的查找

mmm96 发表于 2006-8-14 17:31:00

[求助]关于cad文件的查找

如何用vba编写查找指定文件夹以及子文件夹下的所有cad图形文件，请高手指点

雪山飞狐_lzh 发表于 2006-8-14 17:57:00

dir函数

mmm96 发表于 2006-8-14 18:22:00

<P>能否给出程序代码，谢谢！！</P>

iceberg2509 发表于 2006-8-15 08:46:00

本帖最后由 作者 于 2006-8-15 9:07:35 编辑 <br /><br /> <P>我们在日常编程中经常需要对文件夹进行遍历查找，在VB中，我们可以借助FSO的帮助来实现这个功能。 </P>
<P>一、FSO简介 <BR>　　FSO对象模型包含以下几种对象： <BR>　　Drive对象：允许收集系统物理或通过LAN与系统逻辑连接的硬盘、CD－ROM等驱动器的可用空间、共享名等信息。 <BR>　　Folder对象：允许创建、删除或移动文件夹，并向系统查询文件夹的名称、路径等。 <BR>　　Files对象：允许创建、删除或移动文件，并向系统查询文件的名称、路径等。 <BR>　　TextStream对象：允许创建和读写文本文件。 <BR>　　FileSystemObject对象：提供一整套用于驱动器、文件夹和文件操作的方法，在功能上可以把它看作是上面几个对象的集合并且经常与它们配合使用。与该对象相关联的很多方法重复了前面四个对象中的方法，因此我们既可以通过FileSystemObject对象来对驱动器、文件夹和文件进行大多数操作，也可以通过对应的驱动器、文件夹或文件对象对这些组件进行操作。FSO模型通过两种方法实现对同一对象的操作，其操作效果是相同的，提供这种冗余功能的目的是为了实现最大的编程灵活性。 <BR>　　FSO对象模型包含在一个称为Scripting的类型库中，此类型库位于Scrrun.dll文件中，可从“工程”选单的“引用”对话框中选择“Microsoft Scripting Runtime”项来引用此文件。 <BR>　　创建一个FileSystemObject对象，可以通过如下两种方法来完成：1将一个变量声明为FileSystemObject对象类型：Dim fso As New FileSystemObject；2使用CreateObject方法来创建：Set fso=CreateObject(″Scripting.FileSystemObject″ </P>
<P><BR>二.查找函数的编写 <BR>参数说明: <BR>strDir:目标目录 <BR>strFilter:文件类型 <BR>strArr:存放查找结果的数组 <BR>isTraversal:是否遍历子目录 </P>
<P>Public Function getAllFilesInDir(strDir As String, _ <BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; strFilter As String, _ <BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; strArr() As String, _ <BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; isTraversal As Boolean) <BR>&nbsp;&nbsp; '// 定义了一批FSO对象 <BR>&nbsp;&nbsp; Dim objFSO As New Scripting.FileSystemObject <BR>&nbsp;&nbsp; Dim objFolder As Scripting.Folder <BR>&nbsp;&nbsp; Dim objFile As Scripting.File <BR>&nbsp;&nbsp; Dim objSubdirs As Scripting.Folders <BR>&nbsp;&nbsp; Dim objLoopFolder As Scripting.Folder </P>
<P>&nbsp;&nbsp; '// 取得目录 <BR>&nbsp;&nbsp; Set objFolder = objFSO.GetFolder(strDir) <BR>&nbsp;&nbsp;&nbsp; <BR>&nbsp;&nbsp; '// 遍历目录中的文件 <BR>&nbsp;&nbsp; For Each objFile In objFolder.Files <BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; If strFilter = "*.*" Then <BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; '// 匹配所有文件 <BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; strArr(UBound(strArr)) = objFile.Path <BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; ReDim Preserve strArr(0 To UBound(strArr) + 1) <BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Else <BR>&nbsp;&nbsp; '// 匹配固定扩展名的文件 <BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Dim strTmpArr() As String <BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; strTmpArr = Split(strFilter, ".") <BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Dim strOldExtension As String <BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; strOldExtension = strTmpArr(1) <BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; <BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Dim FSOtemp As New Scripting.FileSystemObject <BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; If FSOtemp.GetExtensionName(objFile.Path) = strOldExtension Then <BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; strArr(UBound(strArr)) = objFile.Path <BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; ReDim Preserve strArr(0 To UBound(strArr) + 1) <BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; End If <BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; End If <BR>&nbsp;&nbsp; Next objFile <BR>&nbsp;&nbsp;&nbsp; <BR>&nbsp;&nbsp; '// 如果isTraversal为真,则进行递归查找 <BR>&nbsp;&nbsp; If isTraversal Then <BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Set objSubdirs = objFolder.SubFolders <BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; For Each objLoopFolder In objSubdirs <BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Call getAllFilesInDir(objLoopFolder.Path, strFilter, strArr, isTraversal) <BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Next objLoopFolder <BR>&nbsp;&nbsp; End If <BR>&nbsp;&nbsp;&nbsp; <BR>&nbsp;&nbsp; '// 清除对象 <BR>&nbsp;&nbsp; Set objSubdirs = Nothing <BR>&nbsp;&nbsp; Set objFolder = Nothing <BR>&nbsp;&nbsp; Set objFSO = Nothing <BR>End Function </P>
<P>三.查找函数的调用 <BR>&nbsp;&nbsp; Dim strArrAllFile() As String <BR>&nbsp;&nbsp; ReDim Preserve strArrAllFile(0 To 0) <BR>&nbsp;&nbsp; Call getAllFilesInDir(strDir, "*.*", strArrAllFile, True) <BR>&nbsp;&nbsp; ReDim Preserve strArrAllFile(0 To UBound(strArrAllFile) - 1) '// 清除掉多余的一个元素&nbsp;</P>

查看完整版本: [求助]关于cad文件的查找