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\"), TextToDisplay:=\"图纸存放路径：\" & mypath

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

rCount = 0

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

ReDim Preserve strArr(rCount)

Address:=mypath,

Do While myfile <> vbNullString

strArr(rCount) = myfile

rCount = rCount + 1

ReDim Preserve strArr(rCount)

myfile = Dir$()

Loop

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

n = 16

Range(\"b16\

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 & \"页！\提示\"

End Sub

表格

文件

图纸和BOM审批单Drawing Approve List图纸存放路径：C:\\Documents and Settings\\clibl\\Desktop\\组件图纸说明：1．审批要求按“Q/JWA07024 技术文件的审批签署规定”；。 2．如果在审批过程中发现图纸有不符合规定而需要修改的，则发现人可不签字并将需要修改的信息告知设计人员。 3．审批结束后将审批单交文件控组资料员，由资料员填写记录编号并归档；工艺会签人员（或其它最后审核的工程师）应在发放部门中列出图纸需要发放的部门；PRS 项目的 P 版图纸 不需填写发放部门。对于需要发放给印度或广州厂的图纸和 BOM 由设计工程师在发放部门进行打勾选择。 4．发放部门参考代号：供应链部（SCM）、压缩机生产部（JPRO）、压缩机质保部（JQA）、压缩机不断改进部（JCI）,空调机加工，空调零件组，空调胀管组，空调容器组，空调总装组，空调 PRS，空调油漆房，城南仓库。 5.“是否已升级”列为确认设计数据库（例：Intralink、Productstream等）中的设计数据是否已升级（即Intralink、Productstream中的Release状态）。升级时应确保设计数据的修订版与图纸版本要一致（例：图库中075WXXXXX-000为 A 版， 075WXXXXX-000 在设计数据库中的修订版也应为 A 版）。自动填单 施工图序图号号1023W22106-0002075W45650-0003075W52117-0004075W52120-0005075W52121-0006075W53201-0007075W55617-0008075W55740-0009075W55741-00010075W55743-00011075W55744-00012075W56099-00013075W65620-00014075W65622-00115075W655-00016075W656-00017075W65651-00018075W66907-00019075W66911-00020075W67582-00021075W74840-02122075W74862-00723075W77929-01824075W79505-00025075W79507-00026075W79508-00027075W79509-00028075W79510-00029075W79511-00030075W79520-00031075W79521-00032075W79524-00533075W79525-00134075W79525-00335075W79525-00436075W79525-00537075W79525-00638075W79525-00739075W79525-00840075W79525-00941075W79530-012075W79530-013075W79530-01744075W79531-00245075W79531-006075W79531-007075W79531-00748075W79531-008竣工图其他ECN No.：标准化日期审核/日期工艺日期是否CA是否已D图升级 否 否 否 否 否 否 否 否 否 否 否 否 否 否 否 否 否 否 否 否 否 否 否 否 否 否 否 否 否 否 否 否 否 否 否 否 否 否 否 否 否 否 否 否 否 否 否 否发放部门页设计（更改版本绘图/日期数）/日期N1N1N1N1N1N1N2N1N1N1N1N1N1N2N2N2N2N2N2N1N2N2N2N2N2N2N2N2N2N3N2N1N1N1N1N1N1N1N1N1N1N1N1N1N1N1N1N1校核/日期