以下代码供参考: '* +++++++++++++++++++++++++++++ '* Created By SHOUROU@ExcelHome 2007-1-1 8:15:39 '仅测试于System: Windows NT Word: 11.0 Language: 2052 '№ 0121^The Code CopyIn [ThisDocument-ThisDocument]^' '* ----------------------------- Option Explicit
Sub GetTitles() '此代码功能为列出指定文件夹中所有选取的WORD文件名和标题 Dim MyDialog As FileDialog, GetTitle As String Dim oSelItem As Variant, myDoc As Document, myRange As Range On Error Resume Next '忽略错误 '定义一个文件夹选取对话框 Set MyDialog = Application.FileDialog(msoFileDialogFilePicker) With MyDialog .Filters.Clear '清除所有文件筛选器中的项目 .Filters.Add "所有 WORD 文件", "*.doc", 1 '增加筛选器的项目为所有WORD文件 .AllowMultiSelect = True '允许多项选择 .Title = "提取文档标题" If .Show = -1 Then '确定 GetTitle = "文件名" & vbTab & "标题" & Chr(13) For Each oSelItem In .SelectedItems '在所有选取项目中循环 GetTitle = GetTitle & vbCrLf & oSelItem Set myDoc = Word.Documents.Open(FileName:=oSelItem, Visible:=False) With myDoc GetTitle = GetTitle & .Name & vbTab & .BuiltInDocumentProperties(wdPropertyTitle) & Chr(13) .Close False End With Next Set myRange = Selection.Range myRange.InsertAfter GetTitle myRange.ParagraphFormat.TabStops.Add Position:=Word.CentimetersToPoints(7.5) End If End With End Sub '----------------------
1M80haLN.rar
(7.08 KB, 下载次数: 10)
|