输入文件名，自动提取文件的路径、项目名称和编号等信息

方漠

如果文件数量不多，WINDOWS 文件搜索功能即可解决．　

以下代码供参考，会在当前工作表ＡＢＣ列列出文件路径名字＋文件大小＋修改日期，稍作修改即可．　

Public Sub FindFile(mPath As String, Optional sFile As String = "")
On Error Resume Next
Dim s As String, sDir() As String
Dim i As Long, d As Long
Dim SF As String, Lrow As Integer

Lrow = 1

If Right(mPath, 1) <> "\" Then
    mPath = mPath & "\"
End If
'List file under folder.
s = Dir(mPath & sFile, vbArchive + vbDirectory + vbHidden + vbNormal + vbReadOnly + vbSystem)
Do While s <> ""
   If s <> "." And s <> ".." Then
       'Debug.Print mPath & s
       SF = mPath & s
  
       ActiveSheet.Range("A" & Lrow) = SF
       ActiveSheet.Range("B" & Lrow) = FileLen(SF)
       ActiveSheet.Range("C" & Lrow) = FileDateTime(SF)
       Lrow = Lrow + 1
   End If
   s = Dir
Loop

'List Sub-folder under folder
s = Dir(mPath, vbArchive + vbDirectory + vbHidden + vbNormal + vbReadOnly + vbSystem)
Do While s <> ""
    If s <> "." And s <> ".." Then
        If (GetAttr(mPath & s) And vbDirectory) = vbDirectory Then
        d = d + 1
        ReDim Preserve sDir(d)
        sDir(d) = mPath & s
       ' Debug.Print "D is " & d & "  Value is " & sDir(d)
        End If
    End If
    s = Dir
Loop

'List recursively　
For i = 1 To d
    FindFile sDir(i) & "\"
Next

End Sub


Sub Test()

Call FindFile("D:\YourPath")

End Sub