VBA RegEx to find files

Question

I need to find files in a folder, and I have 3 cases on files naming:

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

I can handle the first and the second case, but I need to find the third too. the last 16 characters of the 3. filename can variate, so I think to use RegExp to match it, then copy all files in another folder.

the string is stored in an excel cell, but only with "DI#######" naming

1. DI0425522 (A2 cell)
2. DI0425523 (A3 cell)
3. DI0425524 (A4 cell)

This is the code, but it doesn't work: it shows error 438 "object doesn't support this property or method" on the If Dir(Source & "\DI\" & "AL-DN-" & ValoreCella & regex & ".Pdf") <> "" Then line

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

Thanks for help

Answer 1

I tried but doesn't work. Here your code with comments:

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

I Tried this mod:

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

The file string is now correct, but there's not a test with ValoreCella value, so the code will return the first file found in folder, then stops

UPDATE:

I solve the problem without RegExp in this way:

'...

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
'...

Thanks for your help

Answer 2

A RegExp is an object and it doesn't have a default property, so you can't just concatenate it into a string and use it like a wildcard. If you need to find a matching file with Dir, you need to loop over the directory and test each resulting filename with the regular expression until you find a match. You can cut down on some of the extraneous matches by using wildcards in the Pathname argument for Dir - for example, Source & "\DI\*DI???????*.pdf" should eliminate most of them.

Also, because you can't use a "partial" regular expression with Dir, you'll need to build a regular expression that will match any of your file specs completely. This should work based on your example file names:

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

This simplifies your main loop quite a bit. Add a flag for whether or not a match was found, and exit early when you find a match. Something like this should be closer to what you need (untested):

'...
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
'...