VBA文件名提取代码

代码

Private Sub CommandButton1_Click()

Dim strArr()

Dim mypath, myfile As String

Dim rCount, n, m, i, j, i1 As Integer

'**************************

mypath = ThisWorkbook.Path

ActiveSheet.Hyperlinks.Add Anchor:=Range("a5"), Address:=mypath, TextToDisplay:="图纸存放路径：" & mypath

'**************************

rCount = 0

myfile = Dir(mypath & "\*.pdf")

ReDim Preserve strArr(rCount)

Do While myfile <> vbNullString

strArr(rCount) = myfile

rCount = rCount + 1

ReDim Preserve strArr(rCount)

myfile = Dir$()

Loop

'**************************

n = 16

Range("b16", "d200") = ""

For i = LBound(strArr) To UBound(strArr) - 1

For j = 16 To UBound(strArr) + 16

If Range("b" & j) = "" Then Exit For

If Left(strArr(i), 13) = Range("b" & j).Value Then GoTo jump

Next j

Range("b" & n).Value = Left(strArr(i), 13)

Range("c" & n).Value = Mid(strArr(i), 17, 1)

m = 0

For i1 = LBound(strArr) To UBound(strArr)

If Left(strArr(i1), 13) = Left(strArr(i), 13) Then m = m + 1

Next i1

Range("d" & n).Value = m

n = n + 1

n0 = n0 + m

jump: Next i

MsgBox "总共" & n0 & "页！", vbDefaultButton1, "提示"

End Sub

表格

文件