VBA RegEx 查找文件

Question

我需要在文件夹中查找文件，文件命名有3种情况：

1. DI0425522.pdf
2. AL-DN-DI0425523.pdf
3. AL-DN-DI0425524-2016-11-17_1108.pdf

我可以处理第一种和第二种情况，但我也需要找到第三种情况。 3.文件名的最后16个字符可以变化，所以我想用RegExp匹配它，然后将所有文件复制到另一个文件夹中。

字符串存储在 Excel 单元格中，但只能使用“DI#######”命名

1. DI0425522（A2 电池）
2. DI0425523（A3 电池）
3. DI0425524（A4 电池）

这是代码，但它不起作用：它在If Dir(Source & "\DI\" & "AL-DN-" & ValoreCella & regex & ".Pdf") <> "" Then 行显示错误 438“对象不支持此属性或方法”

Sub cerca()
Dim T As Variant
Dim D As Variant

T = VBA.Format(VBA.Time, "hh.mm.ss")
D = VBA.Format(VBA.Date, "yyyy.MM.dd")

Dim Ricercatore As Variant

Ricercatore = Cells(1, 3)

Dim Source As String
Dim Dest As String

Source = "\\it-s-bolo02\WORKGROUP\Comune\000_0_______ COMUNE 2011\15_TECNICO\AAA - RICERCA DDT\ALSS\DDT"
Dest = "\\it-s-bolo02\WORKGROUP\Comune\000_0_______ COMUNE 2011\15_TECNICO\AAA - RICERCA DDT\ALSS\Ricerca\Ricerca " & D & " " & T & " " & Ricercatore

MkDir Dest

Dim ValoreCella As Variant, r As Long, DDTmancanti As Variant

r = 2

Do Until Cells(r, 1) = ""

ValoreCella = Cells(r, 1)

    If Dir(Source & "\DI\" & ValoreCella & ".Pdf") <> "" Then
        FileCopy Source & "\DI\" & ValoreCella & ".Pdf", Dest & "\" &   ValoreCella & ".Pdf"
    Else

        If Dir(Source & "\DI\" & "AL-DN-" & ValoreCella & ".Pdf") <> "" Then
            FileCopy Source & "\DI\" & "AL-DN-" & ValoreCella & ".Pdf", Dest & "\" & "AL-DN-" & ValoreCella & ".Pdf"
        Else

            Dim regex As Object, str As String

            Set regex = CreateObject("VBScript.RegExp")
            str = "-([0-9]*)-([0-9]*)-([0-9]*)_([0-9]*)"
                With regex
                  .Pattern = str
                  .Global = True
                End With

            If Dir(Source & "\DI\" & "AL-DN-" & ValoreCella & regex & ".Pdf") <> "" Then
                FileCopy Source & "\DI\" & "AL-DN-" & ValoreCella & regex & ".Pdf", Dest & "\" & "AL-DN-" & ValoreCella & regex & ".Pdf"
            Else

                If Dir(Source & "\Altro\" & ValoreCella & ".Pdf") <> "" Then
                    FileCopy Source & "\Altro\" & ValoreCella & ".Pdf", Dest & "\" & ValoreCella & ".Pdf"
                Else
                    DDTmancanti = DDTmancanti & ValoreCella & vbCrLf
                End If

            End If

        End If

    End If

r = r + 1

Loop

Dim FF As Long
FF = FreeFile

Open (Dest & "\" & "0 - DDT_mancanti.txt") For Output As #FF
Write #FF, DDTmancanti
Close #FF

MsgBox "Operazione eseguita"
Shell "explorer.exe " + Dest, vbNormalFocus

End Sub

感谢您的帮助

Answer 1

RegExp 是一个对象，它没有默认属性，因此您不能将它连接成一个字符串并像通配符一样使用它。如果您需要找到与Dir 匹配的文件，则需要遍历目录并使用正则表达式测试每个生成的文件名，直到找到匹配项。您可以通过在Dir 的Pathname 参数中使用通配符来减少一些无关的匹配 - 例如，Source & "\DI\*DI???????*.pdf" 应该消除其中的大部分。

此外，由于您不能对Dir 使用“部分”正则表达式，因此您需要构建一个与您的任何文件规范完全匹配的正则表达式。这应该根据您的示例文件名起作用：

^(AL-DN-)?DI\d{7}(-\d{4}-\d{2}-\d{2}_\d{4})?\.pdf$

这大大简化了您的主循环。添加是否找到匹配的标志，并在找到匹配时提前退出。像这样的东西应该更接近你需要的东西（未经测试）：

'...
r = 2

With New RegExp
    .Pattern = "^(AL-DN-)?DI\d{7}(-\d{4}-\d{2}-\d{2}_\d{4})?\.pdf$"
    Do Until Cells(r, 1) = ""
        Dim found As Boolean
        ValoreCella = Cells(r, 1)

        Dim current As String
        current = Dir$(Source & "\DI\*DI???????*.pdf")
        Do Until current = vbNullString
            If .Test(current) Then  'Found the file.
                FileCopy current, Dest & "\" & current
                found = True
                Exit Do
            End If
            current = Dir$()
        Loop

        If Not found Then DDTmancanti = DDTmancanti & ValoreCella & vbCrLf
        found = False
        r = r + 1
    Loop
End With

Dim FF As Long
'...

Answer 2

我试过了，但没有用。这里是你的 cmets 代码：

With New RegExp
.Pattern = "^(AL-DN-)?DI\d{7}(-\d{4}-\d{2}-\d{2}_\d{4})?\.pdf$"
Do Until Cells(r, 1) = ""
    Dim found As Boolean
    ValoreCella = Cells(r, 1)

    Dim current As String
    current = Dir$(Source & "\DI\*DI???????*.pdf")
    Do Until current = vbNullString
        If .Test(current) Then  'Found the file.
            FileCopy current, Dest & "\" & current 'Error 53 File not found--> current var is the first file found without Source string, see image attached

            found = True
            Exit Do
        End If
        current = Dir$()
    Loop

    If Not found Then DDTmancanti = DDTmancanti & ValoreCella & vbCrLf
    found = False
    r = r + 1
Loop
End With

Dim FF As Long

我试过这个模组：

With New RegExp
    .Pattern = "^(AL-DN-)?DI\d{7}(-\d{4}-\d{2}-\d{2}_\d{4})?\.pdf$"
    Do Until Cells(r, 1) = ""
        Dim found As Boolean
        ValoreCella = Cells(r, 1)

        Dim current As String
        current = Dir$(Source & "\DI\*DI???????*.pdf")
        Do Until current = vbNullString
            If .Test(current) Then  'Found the file.
                Dim SourceDI, DestDI As String
                SourceDI = Source & "\DI\" & current
                DestDI = Dest & "\" & current
                FileCopy SourceDI, DestDI
                found = True
                Exit Do
            End If
            current = Dir$()
        Loop

        If Not found Then DDTmancanti = DDTmancanti & ValoreCella & vbCrLf
        found = False
        r = r + 1
    Loop
End With

文件字符串现在是正确的，但没有对 ValoreCella 值的测试，因此代码将返回文件夹中找到的第一个文件，然后停止

更新：

我是这样解决没有RegExp的问题的：

'...

Do Until Cells(r, 1) = ""

    ValoreCella = Cells(r, 1)
        Dim current As String
        current = Dir$(Source & "\DI\*" & ValoreCella & "*.pdf")
        If current <> "" Then
            FileCopy Source & "\DI\" & current, Dest & "\" & current
        Else
            DDTmancanti = DDTmancanti & ValoreCella & vbCrLf
        End If
      r = r + 1

    Loop
'...

感谢您的帮助