|
在Word中创建指定文件夹下doc文件的目录
特别感谢雨雪霏霏
将下面宏放在Word中试试看(要去掉超链接的话,请把 “For Each myPara In ActiveDocument.Paragraphs
Set myRange = ActiveDocument.Range(Start:=myPara.Range.Start, End:=myPara.Range.End - 1)
myText = myRange.Text
myRange.Hyperlinks.Add Anchor:=myRange, Address:=myText
Next '将所有文件名转换为指向原文件的超链接”去掉)
Sub 新建文档_并生成指定文件夹下所有doc文件的链接目录__快速()
Dim myPath As String, myFoundFile
Dim GetStr As String, NewDoc As Document
Dim myText As String
Dim myPara As Paragraph, myRange As Range
On Error Resume Next '如果发生错误则忽略,继续其他语句的执行
Application.ScreenUpdating = False '关闭屏幕更新
With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "选择目标文件夹"
If .Show = -1 Then
myPath = .SelectedItems(1)
Else
Exit Sub
End If
End With '由用户指定对象文件夹
With Application.FileSearch
.LookIn = myPath
.FileType = msoFileTypeWordDocuments '预置文件类型为doc文档
If .Execute > 0 Then '如果该文件夹下存在doc文档,则继续以下操作
For Each myFoundFile In .FoundFiles
GetStr = GetStr & myFoundFile & vbCrLf
Next myFoundFile '取得所有文件名的全路径
Set NewDoc = Documents.Add '新建一个文档
NewDoc.Range.InsertAfter GetStr '在新文档中插入所有文件名
End If
End With
For Each myPara In ActiveDocument.Paragraphs
Set myRange = ActiveDocument.Range(start:=myPara.Range.start, End:=myPara.Range.End - 1)
myText = myRange.Text
myRange.Hyperlinks.Add Anchor:=myRange, Address:=myText
Next '将所有文件名转换为指向原文件的超链接
Application.ScreenUpdating = True '恢复屏幕更新
End Sub
[ 本帖最后由 szqhb 于 2010-3-19 23:11 编辑 ] |
|