search具有不同关键字的文件

我正在编写一个macros，它将查找一个文件并将其附加到电子邮件。

到目前为止，我已经破解了代码，devise如下 – 开始在指定的目录中 – 生成目录中的文件夹列表>导出到临时创build的工作表上的单元格 – 循环访问该文件夹列表，search文件夹的存在（所有这些子文件夹标有numbereg / 13456 /） – 当它find编号的作业文件夹，然后再检查一个子文件夹，“图纸” – 如果文件夹标有“图纸”存在，我们想要的文件将在那里。 – 如果文件夹“图纸”不存在，我们想要的文件将在编号的作业文件夹中。

现在在这里，我陷入困境。 目前，我的代码使用search词“ FIRST .pdf”在这两个位置查找文件。

我也想search其他词组，例如“ UPPER .pdf”，“ 1st .pdf”，“ UF .pdf”。

最好的办法是做一个循环引用表格上的单元格，因此需要创build另一个临时表单并填充更多的单元格？ 还是有一个棘手的方式，这可以用循环代码而不需要这样做？

再一次，我的代码被相当粗暴地砍在一起，就像我去学习一样。 macros观的要求也在不断变化，人们正在意识到还有什么可以做的，所以逻辑并没有一次性devise出来。 ：\

Sub Concrete_Order() 'code deleted from above area in question Dim foldersearchpath As String, ctr As Integer, UFPLANNAME As String, UFPLANpdf As String ctr = 1 Sheets.Add After:=Sheets(Sheets.Count) ActiveSheet.Name = "asdf" Path = "K:\drafting\jobs\1DETAILING\" 'always have "\" at end FirstDir = Dir(Path, vbDirectory) Do Until FirstDir = "" If (GetAttr(Path & FirstDir) And vbDirectory) = vbDirectory Then ActiveSheet.Cells(ctr, 1).Value = Path & FirstDir ctr = ctr + 1 End If FirstDir = Dir() Loop Sheets("asdf").Select ctr = ctr - 1 'counter correction Do Until ctr = 2 foldersearchpath = Range("A" & ctr) & "\" & jobNumber & "\" Dim FldrCheck As String, FldrCheck2 As String, UFPlanFile As String FldrCheck = Dir(foldersearchpath, vbDirectory) If Len(FldrCheck) > 0 Then FldrCheck2 = Dir(foldersearchpath & "drawings\", vbDirectory) If Len(FldrCheck2) > 0 Then foldersearchpath = foldersearchpath & "drawings\" file = Dir(foldersearchpath & "*FIRST*.pdf") If file <> "" Then UFPlanFile = foldersearchpath & file GoTo planfileFound Else GoTo UFPLAN_MANUAL_attach End If Else file = Dir(foldersearchpath & "*FIRST*.pdf") If file <> "" Then UFPlanFile = foldersearchpath & file GoTo planfileFound Else GoTo UFPLAN_MANUAL_attach End If End If Else End If ctr = ctr - 1 Loop On Error GoTo 0 UFPLAN_MANUAL_attach: Dim fd As Office.FileDialog Set fd = Application.FileDialog(msoFileDialogFilePicker) With fd .AllowMultiSelect = False .Application.FileDialog(msoFileDialogOpen).InitialFileName = foldersearchpath .Title = "Could not find Upper Floor Plan, please locate..." .Filters.Clear .Filters.Add "Adobe PDF", "*.pdf" .Filters.Add "John File", "*.god" .Filters.Add "All Files", "*.*" If .Show = True Then 'user clicked ok UFPlanFile = .SelectedItems(1) 'replace txtFileName with your textbox End If End With planfileFound: Application.DisplayAlerts = False Sheets("asdf").Select ActiveWindow.SelectedSheets.Delete Application.DisplayAlerts = True On Error GoTo 0 'code deleted from after End Sub 

Answer 1

大多数编程语言都有一个dynamic列表的inbuild类。 Vba有Collection类。 您可以添加项目。使用（i）添加和检索项目，或者使用“For Each”来遍历每个项目

 Sub Concrete_Order() 'code deleted from above area in question Dim foldersearchpath As String, ctr As Integer, UFPLANNAME As String, UFPLANpdf As String Dim foundDirectories As Collection Set foundDirectories = New Collection Path = "K:\drafting\jobs\1DETAILING\" 'always have "\" at end FirstDir = Dir(Path, vbDirectory) Do Until FirstDir = "" If (GetAttr(Path & FirstDir) And vbDirectory) = vbDirectory Then foundDirectories.Add Path & FirstDir End If FirstDir = Dir() Loop Dim possibleFileNames As Collection Set possibleFileNames = New Collection possibleFileNames.Add "*FIRST*.pdf" possibleFileNames.Add "UPPER.pdf" possibleFileNames.Add "1st.pdf" possibleFileNames.Add "UF.pdf" Dim currentDirectory For Each currentDirectory In foundDirectories foldersearchpath = currentDirectory & "\" & jobNumber & "\" Dim FldrCheck As String, FldrCheck2 As String, UFPlanFile As String FldrCheck = Dir(foldersearchpath, vbDirectory) If Len(FldrCheck) > 0 Then FldrCheck2 = Dir(foldersearchpath & "drawings\", vbDirectory) If Len(FldrCheck2) > 0 Then foldersearchpath = foldersearchpath & "drawings\" End If Dim possibleFileName For Each possibleFileName In possibleFileNames file = Dir(foldersearchpath & possibleFileName) If file <> "" Then UFPlanFile = foldersearchpath & file GoTo planfileFound End If Next GoTo UFPLAN_MANUAL_attach End If Next On Error GoTo 0 UFPLAN_MANUAL_attach: Dim fd As Office.FileDialog Set fd = Application.FileDialog(msoFileDialogFilePicker) With fd .AllowMultiSelect = False .Application.FileDialog(msoFileDialogOpen).InitialFileName = foldersearchpath .Title = "Could not find Upper Floor Plan, please locate..." .Filters.Clear .Filters.Add "Adobe PDF", "*.pdf" .Filters.Add "John File", "*.god" .Filters.Add "All Files", "*.*" If .Show = True Then 'user clicked ok UFPlanFile = .SelectedItems(1) 'replace txtFileName with your textbox End If End With planfileFound: On Error GoTo 0 'code deleted from after End Sub