检索pdf文件:如果文件名是前8位为数字和第9位为英文字母的PDF文件名

JUMU

2025/09/30 13:06:19

编写excel VBA程序：检索当前文件夹“C:\Users\ZHU-222\Desktop\图纸及清单”中的所有文件，包括子文件夹。检索pdf文件。如果文件名是前8位为数字和第9位为英文字母的PDF文件名。将这些文件名暂存。然后在当前excel表D列和F列第三行开始依次填入文件名中的前8位数字，同时在对应的E列和G列填入第9位字母。

Sub ExtractPDFNames()
Dim fso As Object
Dim folderPath As String
Dim mainFolder As Object
Dim subFolder As Object
Dim file As Object
Dim rowNum As Long
Dim regex As Object
Dim matches As Object
' 设置目标文件夹路径
folderPath = "C:\Users\ZHU-222\Desktop\图纸及清单"
' 创建文件系统对象
Set fso = CreateObject("Scripting.FileSystemObject")
Set mainFolder = fso.GetFolder(folderPath)
' 创建正则表达式对象
Set regex = CreateObject("VBScript.RegExp")
regex.Pattern = "^(\d{8})([A-Za-z])\.pdf$"
regex.IgnoreCase = True
rowNum = 3 ' 从第3行开始填充
' 遍历主文件夹及子文件夹
Call TraverseFolders(mainFolder, regex, rowNum)
MsgBox "处理完成，共处理 " & (rowNum - 3) & " 个文件", vbInformation
End Sub
Sub TraverseFolders(currentFolder As Object, regex As Object, ByRef rowNum As Long)
Dim subFolder As Object
Dim file As Object
' 遍历当前文件夹中的文件
For Each file In currentFolder.Files
If LCase(Right(file.Name, 4)) = ".pdf" Then
Dim matches As Object
If regex.Test(file.Name) Then
Set matches = regex.Execute(file.Name)
Dim numPart As String
Dim letterPart As String
numPart = matches(0).SubMatches(0)
letterPart = UCase(matches(0).SubMatches(1))
' 写入Excel单元格
With ThisWorkbook.ActiveSheet
.Cells(rowNum, 4).Value = numPart ' D列
.Cells(rowNum, 5).Value = letterPart ' E列
.Cells(rowNum, 6).Value = numPart ' F列
.Cells(rowNum, 7).Value = letterPart ' G列
End With
rowNum = rowNum + 1
End If
End If
Next
' 递归遍历子文件夹
For Each subFolder In currentFolder.SubFolders
TraverseFolders subFolder, regex, rowNum
Next
End Sub

进入原文