标题可能需要进行调整,因为它可能会出现重复的问题。
对于这个冗长的问题,我深表歉意。
借助这些链接:
VBA macro that search for file in multiple subfolders
VBA search for a specific subfolder in many folders and move all the files in it
我有以下代码:
Public Sub grab_Folder_Name()
Dim todayDate As String, yesterdayDate As String, folderTime As String, startTime As String, endTime As String
Dim basePath As String, fileName As String
Dim parentFolder As Folder, subFolder1 As Folder, subFolder2 As Folder
Dim myDateArray As Variant
Dim fsoFileSystem As New FileSystemObject
Dim tmpltWkbk As Workbook
Dim kwArray As Variant, sTime As Variant, eTime As Variant
Dim ws1 As Worksheet
Dim i As Long, r As Range
'Set dates to look between
todayDate = Format(DateAdd("d", 0, Date), "dd_mm_YYYY")
yesterdayDate = Format(DateAdd("d", -1, Date), "dd_mm_YYYY")
'Set workbook to work with
Set tmpltWkbk = Workbooks("Template.xlsm")
'Set sheet to work with
Set ws1 = tmpltWkbk.Sheets("Run Results")
'Set default time structure in variable
folderTime = "##.##.##"
'Set date array
myDateArray = Array(todayDate, yesterdayDate)
'Set time Array for Start Time
sTime = Array("18:00:00", "00:00:00")
'Set time Array for End Time
eTime = Array("11:59:00", "06:00:00")
'Get the range to use
Set rng = find_Header("KW ID", "Array")
'Print out array values
'Just for my debugging
ReDim arr(1 To rng.count)
i = 1
For Each r In rng
arr(i) = r.Value
i = i + 1
Next r
kwArray = arr
For i = LBound(kwArray) To UBound(kwArray)
Debug.Print kwArray(i)
Next
'Get the path of the parent folder
basePath = "\\path"
'Set the parent folder
Set parentFolder = fsoFileSystem.GetFolder(basePath)
'Check if the path contains a \ at the end, if not then add it
If Right(basePath, 1) <> "\" Then basePath = basePath & "\"
'Set the directory in a variable
fileName = Dir(basePath, vbDirectory)
'Looop through all the KW
For Each kwID In kwArray
'Loop through all the dates
For Each myDate In myDateArray
'Loop through all the first set of subfolders
For Each subFolder1 In parentFolder.SubFolders
Debug.Print subFolder1.Name
Debug.Print myDate
If subFolder1.Name Like Not "########_##-##-##_##.##.##" Then
'Don't know what to do - Do nothing?
Else
'********** This never seems to be a match **********
'Check if the subFolder1 matches the format
If subFolder1.Name = "########_" & myDate & "_" & folderTime Then
If myDate = todayDate Then
startTime = sTime(1)
endTime = eTime(1)
ElseIf myDate = yesterdayDate Then
startTime = sTime(2)
endTime = eTime(2)
End If
'Check if the subFolder1 is between the times specified
If subFolder1.DateCreated > startTime And subFolder1.DateCreated < endTime Then
'Loop through all the second set of subfolders
For Each subFolder2 In subFolder1.SubFolders
'Check if the subFolder2 matches the format
If subFolder2.Name = "#########_" & kwID & "_" & folderTime Then
With ws1
'.Hyperlinks.Add Anchor:=.Cells.Find(what:=kwID)
'Grab the hyperlink
'Address:=subFolder1.path
'.FollowHyperlink subFolder1.path
'Nothing happens here - The If Condition is not met
Debug.Print subFolder1.Name
End With
End If
Next subFolder2
End If
End If
End If
'This one prints all the folder names in this folder
Debug.Print subFolder1.Name
Next subFolder1
Next myDate
Next kwID
End Sub
以下是我需要和仍然需要做的事情的细分:
我提供的代码一直到第8步-到目前为止,第9到12步我还没有任何东西
这是我遇到的问题:
If subFolder1.Name = "########_" & myDate & "_" & folderTime Then
,所以我无法测试其后发生的事情.Hyperlinks.Add Anchor:=.Cells.Find(what:=kwID)
上出现错误参数不是可选的
如果我能够解决遇到的问题,那么我可以继续完成剩余的任务并添加到代码中。