如何能在excel2003表格中引用word文件自身的文件名?

2025-01-02 16:48:51
推荐回答(1个)
回答1:

通过BeginSearch函数开始

Sub BeginSearch()
Dim searchPach As String '初始搜索路径
Dim rowNum As Long '链接据的单元格行
Dim columnNum As Long '链接据的单元格列
Dim attrName As Integer '文件属性
Dim searchSubPach As Boolean '是否搜索子目录
Dim temRow As Long
Dim temCol As Long

searchSubPach = True '在此设置是否搜索子目录。搜索子目录设为"True",不搜索子目录设为"False"
rowNum = 1 '在此设置搜索到的第一个链接存放所在的行
columnNum = 1 '在此设置搜索到的第一个链接存放所在的列
searchPach = "E:\" '在此设置搜索的目录

If vbOK = MsgBox("生成目录结构前,是否要先删除表内的所有数据!", _
vbInformation Or vbOKCancel, "操作提示") Then
ThisWorkbook.Worksheets(1).UsedRange.Clear
End If
temRow = rowNum
temCol = columnNum
Call FilePathInRange(rowNum, columnNum, searchPach, searchSubPach)
MsgBox searchPach & "下共有文件和目录" & _
rowNum - temRow + 65536 * (columnNum - temCol) & "个", _
vbOKOnly, "通告"
End Sub

Public Sub FilePathInRange(rowNum As Long, columnNum As Long, searchPach As String, searchSubPach As Boolean)
Dim haveSubPath As Boolean
Dim strName As String
Dim attrName As Integer
Dim tempPath

strName = Dir(searchPach, vbDirectory)
Do While strName = "." Or strName = ".."
strName = Dir()
Loop

Do While (strName <> "")
attrName = GetAttr(searchPach & strName)
If attrName = vbDirectory And searchSubPach Then
subPathStr = subPathStr & strName & "|"
haveSubPath = True
End If

ThisWorkbook.Worksheets(1).Hyperlinks.Add Cells(rowNum, columnNum), _
Address:=searchPach & strName, TextToDisplay:=searchPach & strName

rowNum = rowNum + 1

If rowNum > 65536 And columnNum < 256 Then
rowNum = 1
columnNum = columnNum + 1
ElseIf rowNum > 65536 And columnNum > 256 Then
' "目录和文件太多,无法容纳!", vbOKOnly Or vbCritical, "数据超限"
End If
strName = Dir()
Loop

If haveSubPath Then
tempPath = searchPach
Dim subPath
subPath = Split(subPathStr, "|")
For i = 0 To UBound(subPath) - 1
Call FilePathInRange(rowNum, columnNum, tempPath & subPath(i) & "\", searchSubPach)
Next i
End If
End Sub