在多个子文件夹中搜索文件的VBA宏

在多个子文件夹中搜索文件的VBA宏

我有宏,如果我放入文件的单元格E1名称,宏搜索通过C:\ Users \ Marek \ Desktop \ Makro \目录,找到它并将所需的值放在我的原始文件的特定单元格中。

是否可以在没有特定文件夹位置的情况下完成此工作?我需要一些可以搜索C:\ Users \ Marek \ Desktop \ Makro \的东西,里面有很多子文件夹。

我的代码:

Sub Zila1()Dim SaveDriveDir As String, MyPath As StringDim FName As VariantDim YrMth As StringSaveDriveDir = CurDir
MyPath = Application.DefaultFilePath    'or use "C:\Data"ChDrive MyPath
ChDir MyPath
FName = Sheets("Sheet1").Range("E1").TextIf FName = False Then
    'do nothingElse
    GetData "C:\Users\Marek\Desktop\Makro\" & FName & ".xls", "Vystupna_kontrola", _        "A16:A17", Sheets("Sheet1").Range("B2:B3"), True, False

        GetData "C:\Users\Marek\Desktop\Makro\" & FName & ".xls", "Vystupna_kontrola", _        "AE23:AE24", Sheets("Sheet1").Range("B3:B4"), True, False

        GetData "C:\Users\Marek\Desktop\Makro\" & FName & ".xls", "Vystupna_kontrola", _        "AE26:AE27", Sheets("Sheet1").Range("B4:B5"), True, False

        GetData "C:\Users\Marek\Desktop\Makro\" & FName & ".xls", "Vystupna_kontrola", _        "AQ59:AQ60", Sheets("Sheet1").Range("B5:B6"), True, False

        GetData "C:\Users\Marek\Desktop\Makro\" & FName & ".xls", "Vystupna_kontrola", _        "AR65:AR66", Sheets("Sheet1").Range("B6:B7"), True, False

        End If

  ChDrive SaveDriveDir
  ChDir SaveDriveDirEnd Sub


繁花如伊
浏览 979回答 3
3回答

万千封印

此子将填充一个Collection,其中包含与您传入的文件名或模式匹配的所有文件。Sub&nbsp;GetFiles(StartFolder&nbsp;As&nbsp;String,&nbsp;Pattern&nbsp;As&nbsp;String,&nbsp;_ &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;DoSubfolders&nbsp;As&nbsp;Boolean,&nbsp;ByRef&nbsp;colFiles&nbsp;As&nbsp;Collection) &nbsp;&nbsp;&nbsp;&nbsp;Dim&nbsp;f&nbsp;As&nbsp;String,&nbsp;sf&nbsp;As&nbsp;String,&nbsp;subF&nbsp;As&nbsp;New&nbsp;Collection,&nbsp;s&nbsp;&nbsp;&nbsp;&nbsp;If&nbsp;Right(StartFolder,&nbsp;1)&nbsp;<>&nbsp;"\"&nbsp;Then&nbsp;StartFolder&nbsp;=&nbsp;StartFolder&nbsp;&&nbsp;"\" &nbsp;&nbsp;&nbsp;&nbsp;f&nbsp;=&nbsp;Dir(StartFolder&nbsp;&&nbsp;Pattern) &nbsp;&nbsp;&nbsp;&nbsp;Do&nbsp;While&nbsp;Len(f)&nbsp;>&nbsp;0 &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;colFiles.Add&nbsp;StartFolder&nbsp;&&nbsp;f &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;f&nbsp;=&nbsp;Dir() &nbsp;&nbsp;&nbsp;&nbsp;Loop &nbsp;&nbsp;&nbsp;&nbsp;sf&nbsp;=&nbsp;Dir(StartFolder,&nbsp;vbDirectory) &nbsp;&nbsp;&nbsp;&nbsp;Do&nbsp;While&nbsp;Len(sf)&nbsp;>&nbsp;0 &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;If&nbsp;sf&nbsp;<>&nbsp;"."&nbsp;And&nbsp;sf&nbsp;<>&nbsp;".."&nbsp;Then &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;If&nbsp;(GetAttr(StartFolder&nbsp;&&nbsp;sf)&nbsp;And&nbsp;vbDirectory)&nbsp;<>&nbsp;0&nbsp;Then &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;subF.Add&nbsp;StartFolder&nbsp;&&nbsp;sf&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;End&nbsp;If &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;End&nbsp;If &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;sf&nbsp;=&nbsp;Dir() &nbsp;&nbsp;&nbsp;&nbsp;Loop &nbsp;&nbsp;&nbsp;&nbsp;For&nbsp;Each&nbsp;s&nbsp;In&nbsp;subF &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;GetFiles&nbsp;CStr(s),&nbsp;Pattern,&nbsp;True,&nbsp;colFiles&nbsp;&nbsp;&nbsp;&nbsp;Next&nbsp;sEnd&nbsp;Sub用法:Dim&nbsp;colFiles&nbsp;As&nbsp;New&nbsp;Collection GetFiles&nbsp;"C:\Users\Marek\Desktop\Makro\",&nbsp;FName&nbsp;&&nbsp;".xls",&nbsp;True,&nbsp;colFilesIf&nbsp;colFiles.Count&nbsp;>&nbsp;0&nbsp;Then &nbsp;&nbsp;&nbsp;&nbsp;'work&nbsp;with&nbsp;found&nbsp;filesEnd&nbsp;If
打开App,查看更多内容
随时随地看视频慕课网APP