Looking for some help with my macro that loops through subfolders and brings back data from the workbooks that match my filename pattern, because the name changes each month.
It works seamlessly if the pattern is "[0-9][0-9][0-9][0-9][0-9][0-9] Filename"
But fails if "[0-9][0-9][0-9][0-9]_[0-9][0-9] Filename"
Any ideas on how to handle the underscore please?
This fails "[0-9][0-9][0-9][0-9][_][0-9][0-9] Filename"
Thanks heaps GWS
Option Explicit
Option Base 1
Private Const PORTFOLIO_CODE As String = "G030"
Private Sub ExtractData()
' get workbook list
Dim wbList As Collection
Set wbList = New Collection
Application.DisplayAlerts = False
RecursiveFileSearch _
"O:\Sales and Marketing\Monthly Reports\", _
"[0-9][0-9][0-9][0-9][_][0-9][0-9] Monthly Report.xlsm", _ 'fails to find any workbooks
'"[0-9][0-9][0-9][0-9][0-9][0-9] Monthly Report.xlsm", _ 'would work except my file names contain underscores
wbList
Dim resultOffset As Integer
wsResult.Name = result
resultOffset = 1
Dim wbName As Variant, wbOpen As Workbook, wsFund As Worksheet
For Each wbName In wbList
' loop through workbook list
' - open workbook, hidden
Application.ScreenUpdating = False
Set wbOpen = Workbooks.Open(Filename:=wbName, ReadOnly:=True)
wbOpen.Windows(1).Visible = False
' - get worksheet for fund
Set wsFund = wbOpen.Worksheets(PORTFOLIO_CODE)
Application.ScreenUpdating = True
' - find top of data
Dim valueDate As Date
valueDate = WorksheetFunction.EoMonth(DateSerial(2000 + CInt(Left(wbOpen.Name, 2)), CInt(Mid(wbOpen.Name, 3, 2)), 1), 0)
Debug.Print valueDate, wbOpen.Name
ThisWorkbook.Worksheets(PORTFOLIO_CODE).Activate
Dim baseData As Excel.Range
Set baseData = wsFund.Range("AQ:AQ").Find("Currency")
If Not baseData Is Nothing Then
' - loop through data
Dim rowOffset As Integer
rowOffset = 0
wsResult.Range("A1").Offset(resultOffset, 0).Value = valueDate ' baseData.Offset(rowOffset, 0).Value
wsResult.Range("A1").Offset(resultOffset, 1).Value = baseData.Offset(rowOffset, 0).Value
wsResult.Range("A1").Offset(resultOffset, 2).Value = baseData.Offset(rowOffset, 5).Value
resultOffset = resultOffset + 1
End If
' - close workbook
wbOpen.Close SaveChanges:=False
DoEvents
Next
Application.DisplayAlerts = True
End Sub
RecursiveFileSearch
Sub RecursiveFileSearch( _
ByVal targetFolder As String, _
ByRef filePattern As String, _
ByRef matchedFiles As Collection _
)
Dim oRegExp As New VBScript_RegExp_55.RegExp
oRegExp.Global = False
oRegExp.IgnoreCase = True
oRegExp.MultiLine = False
oRegExp.Pattern = filePattern
Dim oFSO As Scripting.FileSystemObject
Set oFSO = New Scripting.FileSystemObject
'Get the folder oect associated with the target directory
Dim oFolder As Variant
Set oFolder = oFSO.GetFolder(targetFolder)
'Loop through the files current folder
Dim oFile As Variant
For Each oFile In oFolder.Files
If oRegExp.test(oFile.Name) Then
matchedFiles.Add oFile
End If
Next
'Loop through the each of the sub folders recursively
Dim oSubFolders As Object
Set oSubFolders = oFolder.Subfolders
Dim oSubfolder As Variant
For Each oSubfolder In oSubFolders
RecursiveFileSearch oSubfolder, filePattern, matchedFiles
Next
'Garbage Collection
Set oFolder = Nothing
Set oFile = Nothing
Set oSubFolders = Nothing
Set oSubfolder = Nothing
Set oFSO = Nothing
Set oRegExp = Nothing
End Sub
