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

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

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

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

dir函数

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

能否给出程序代码，谢谢！！

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

本帖最后由作者于 2006-8-15 9:07:35 编辑

我们在日常编程中经常需要对文件夹进行遍历查找，在VB中，我们可以借助FSO的帮助来实现这个功能。

一、FSO简介
　　FSO对象模型包含以下几种对象：
　　Drive对象：允许收集系统物理或通过LAN与系统逻辑连接的硬盘、CD－ROM等驱动器的可用空间、共享名等信息。
　　Folder对象：允许创建、删除或移动文件夹，并向系统查询文件夹的名称、路径等。
　　Files对象：允许创建、删除或移动文件，并向系统查询文件的名称、路径等。
　　TextStream对象：允许创建和读写文本文件。
　　FileSystemObject对象：提供一整套用于驱动器、文件夹和文件操作的方法，在功能上可以把它看作是上面几个对象的集合并且经常与它们配合使用。与该对象相关联的很多方法重复了前面四个对象中的方法，因此我们既可以通过FileSystemObject对象来对驱动器、文件夹和文件进行大多数操作，也可以通过对应的驱动器、文件夹或文件对象对这些组件进行操作。FSO模型通过两种方法实现对同一对象的操作，其操作效果是相同的，提供这种冗余功能的目的是为了实现最大的编程灵活性。
　　FSO对象模型包含在一个称为Scripting的类型库中，此类型库位于Scrrun.dll文件中，可从“工程”选单的“引用”对话框中选择“Microsoft Scripting Runtime”项来引用此文件。
　　创建一个FileSystemObject对象，可以通过如下两种方法来完成：1将一个变量声明为FileSystemObject对象类型：Dim fso As New FileSystemObject；2使用CreateObject方法来创建：Set fso=CreateObject(″Scripting.FileSystemObject″

二.查找函数的编写
参数说明:
strDir:目标目录
strFilter:文件类型
strArr:存放查找结果的数组
isTraversal:是否遍历子目录

Public Function getAllFilesInDir(strDir As String, _
                                strFilter As String, _
                                strArr() As String, _
                                isTraversal As Boolean)
   '// 定义了一批FSO对象
   Dim objFSO As New Scripting.FileSystemObject
   Dim objFolder As Scripting.Folder
   Dim objFile As Scripting.File
   Dim objSubdirs As Scripting.Folders
   Dim objLoopFolder As Scripting.Folder

   '// 取得目录
   Set objFolder = objFSO.GetFolder(strDir)

   '// 遍历目录中的文件
   For Each objFile In objFolder.Files
       If strFilter = "*.*" Then
           '// 匹配所有文件
           strArr(UBound(strArr)) = objFile.Path
           ReDim Preserve strArr(0 To UBound(strArr) + 1)
       Else
   '// 匹配固定扩展名的文件
           Dim strTmpArr() As String
           strTmpArr = Split(strFilter, ".")
           Dim strOldExtension As String
           strOldExtension = strTmpArr(1)

           Dim FSOtemp As New Scripting.FileSystemObject
           If FSOtemp.GetExtensionName(objFile.Path) = strOldExtension Then
               strArr(UBound(strArr)) = objFile.Path
               ReDim Preserve strArr(0 To UBound(strArr) + 1)
           End If
       End If
   Next objFile

   '// 如果isTraversal为真,则进行递归查找
   If isTraversal Then
       Set objSubdirs = objFolder.SubFolders
       For Each objLoopFolder In objSubdirs
           Call getAllFilesInDir(objLoopFolder.Path, strFilter, strArr, isTraversal)
       Next objLoopFolder
   End If

   '// 清除对象
   Set objSubdirs = Nothing
   Set objFolder = Nothing
   Set objFSO = Nothing
End Function

三.查找函数的调用
   Dim strArrAllFile() As String
   ReDim Preserve strArrAllFile(0 To 0)
   Call getAllFilesInDir(strDir, "*.*", strArrAllFile, True)
   ReDim Preserve strArrAllFile(0 To UBound(strArrAllFile) - 1) '// 清除掉多余的一个元素

账号		自动登录	找回密码
密码			注册