VBA RegEx to find files - regex

Question

I need to find files in a folder, and I have 3 cases on files naming:
DI0425522.pdf
AL-DN-DI0425523.pdf
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
DI0425522 (A2 cell)
DI0425523 (A3 cell)
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

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

Answer 2

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