VBA RegEx查找文件

我需要find文件夹中的文件，我有3个文件命名的情况下：

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

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

该string存储在一个Excel单元格，但只有“DI #######”命名

1. DI0425522（A2细胞）
2. DI0425523（A3单元格）
3. DI0425524（A4格）

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

 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是一个对象，它没有默认的属性，所以你不能把它连接成一个string并像通配符一样使用它。 如果您需要使用Dir查找匹配的文件，则需要遍历目录并使用正则expression式testing每个生成的文件名，直到find匹配项。 您可以通过在Dir的Pathname参数中使用通配符来减less一些无关的匹配 – 例如， Source & "\DI\*DI???????*.pdf"应该会消除其中的大部分。

此外，因为不能在Dir使用“部分”正则expression式，所以需要构build一个正则expression式， 完全匹配任何文件规范。 这应该基于您的示例文件名称工作：

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

这相当简化你的主循环。 添加是否find匹配的标志，并在find匹配时提前退出。 像这样的东西应该更接近你所需要的（未经testing）：

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

我试过，但不行。 在这里你的代码与评论：

 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 

我试过这个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 

文件string现在是正确的，但是没有ValoreCella值的testing，所以代码将返回在文件夹中find的第一个文件，然后停止

更新：

我以这种方式解决了没有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 '... 

谢谢你的帮助