Question

寻找一些帮助我的宏循环子文件夹并从工作簿中返回与我的文件名模式匹配的数据，因为名称每个月都会更改。

如果模式是＆＃34; [0-9] [0-9] [0-9] [0-9] [0-9] [0-9]文件名＆＃34;它可以无缝地工作。

但如果＆＃34; [0-9] [0-9] [0-9] [0-9] _ [0-9] [0-9]文件名＆＃34;则失败

有关如何处理下划线的任何想法吗？

此操作失败＆＃34; [0-9] [0-9] [0-9] [0-9] [_] [0-9] [0-9]文件名＆＃34;

谢谢堆 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

Answer 1

我的代码正在逃避（）和。覆盖定义的正则表达式行为。波特兰亚军的建议解决了这个问题。 ^ [0-9] {3,4} [_] [0-9] {2} SAMPSON国际股票被动（对冲）信托授权每月报告.xlsm

Answer 2

也许：

\d{4}_\d{2}.*Monthly Report\.xlsm

VBA正则表达式模式：在我的模式中使用下划线时失败

2 个答案: