我正在编写一个宏,它会找到一个文件并将其附加到电子邮件中。
到目前为止,我所拥有的黑客攻击代码的设计如下 - 从指定目录开始 - 生成目录中的文件夹列表>导出到临时创建的工作表上的单元格 - 循环浏览此文件夹列表,搜索文件夹的存在(所有这些子文件夹都由job numbereg。/ 13456 /标记) - 当找到编号的作业文件夹时,它会再检查一个子文件夹,“图纸” - 如果文件夹标有“图纸”,则我们想要的文件将在那里。 - 如果文件夹标记“图纸”不存在,我们想要的文件将在编号的作业文件夹中。
现在我在这里被卡住了。 目前,我的代码在这两个位置查找文件,搜索字词为“ FIRST .pdf”。
我还想搜索其他短语,例如“ UPPER .pdf”,“ 1st .pdf”,“ UF 。 PDF”。
执行此操作的最佳方法是引用表格中的单元格的循环,因此需要创建另一个临时表格并填充更多单元格吗?或者是否有一种棘手的方法可以使用循环代码完成而不需要它?
同样,我的代码非常粗略地被黑客攻击,就像我去学习一样。 此外,宏的要求不断变化,因为人们正在努力实现它可以用它做什么,所以逻辑并没有一次性设计。 :\
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
答案 0 :(得分:1)
大多数编程语言都有动态列表的内置类。 Vba有Collection类。您可以使用.Add添加项目并使用(i)检索项目或使用&#34; For Each&#34;遍历每个项目
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