Office中国论坛/Access中国论坛

标题: 输入文件名，自动提取文件的路径、项目名称和编号等信息 [打印本页]

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

作者: 方漠 时间: 2020-9-9 12:13
如果文件数量不多，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

欢迎光临 Office中国论坛/Access中国论坛 (http://www.office-cn.net/)