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

adouleonshaw

0、文件系统都是两层结构的文件夹。
1、在F列输入文件名称，如果对应的文件夹下有对应的PDF或者doc文件，则在B、C、D和E列分别自动显示文件全路径（含文件名）、项目名称、子项目名称和编号。
2、在F列输入文件名称，如果对应文件夹下没有相应的PDF或者doc文件，则只在E列显示该文件的编号。待文件放入某个文件夹后，则自动提取该文件对应的信息填充到B、C、D列数据。
3、各列信息的提取，最好用vba的function函数实现。
请各位老师帮帮我。

方漠

如果文件数量不多，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