vba提取多個word文件的標題

㈠ 怎麼是用VBA批量提取word文檔指定內容到Excel

Sub abc()
Dim App, WrdDoc, MyPath, MyFile, BM, Str
Mypath = "文件實際路徑\*.doc" '請修改實際儲存路徑！
Set App = CreateObject("Word.Application") '用Set關鍵字創建Word應用成序對象！
MyFile = Dir(Mypath) ' 獲得第一個WORD文檔
do while MyFile <> "" ' 遍歷Mypath下面的所有WORD文檔
App.Visible = True
Set WrdDoc = App.Documents.Open(MyFile) '打開這個Word文件！
for each BM in WrdDoc.Bookmarks ' 遍歷文檔中的所有書簽
Str = BM.Range ' 讀取書簽內容
next BM

WrdDoc.Close ' 關閉文件

MyFile = Dir ' 下一個WORD文檔

Loop
Set App = Nothing
End Sub

㈡ 如何用VBA取得Word文檔中的標題前面的序號

Sub test()
Dim myRange As Range
Dim num as String, title as String

'Set ps = Selection.Bookmarks("\headinglevel").Range.Paragraphs
Set ps = ActiveDocument.Bookmarks("\headinglevel").Range.Paragraphs
For Each p In ps
Set myRange = p.Range
num = myRange.ListFormat.ListString
title = myRange.Text
MsgBox "編號：" & num & vbCrLf & "標題內容：" & title
Next p

'Set myRange = Selection.Bookmarks("\headinglevel").Range.Paragraphs(1).Range
'MsgBox "編號：" & myRange.ListFormat.ListString & vbCrLf & "標題內容：" & myRange.Text
End Sub

另外附上一段把標題(Heading)序號取出並附加在標題內容後面的代碼：

Sub ReplaceHeadingContent()
Dim myRange As Word.Range
Dim num As String, content As String

'取得所有書簽
Set ps = ActiveDocument.Bookmarks("\headinglevel").Range.Paragraphs

'對書簽中每一個段落進行處理
For Each p In ps
Set myRange = p.Range

With myRange
'把Range結束范圍往前移一個字元，目的是為了不包括換行符
.MoveEnd Unit:=wdWord, Count:=-1

'取出段落序號
num = Trim(.ListFormat.ListString)

'取出Heading的內容
content = Trim(.Text)

'如果段落序號不為空，則把段落序號取出附加的標題內容後面
If Trim(num) <> "" Then
If num = "1.1.1.1.1." Or num = "1.1.1.1.1" Then
MsgBox "到目標點了。"
End If

If Right(num, 1) = "." Then num = Left(num, Len(num) - 1) '不需段落序號最後面的「.」
.Text = content & "<" & num & ">"
End If
'MsgBox "編號：" & num & vbCrLf & "標題內容：" & content
End With
Next p
End Sub

㈢ 如何利用VBA代碼或者腳本代碼批量修改word文檔的正文標題

操作步驟。
第一，首先將需要批量替換的多個Word文檔放在同一文件夾下面。
第二，新建一空白Word文檔，右擊空白工具欄，單擊「控制項工具箱」，就可以看到屏幕上調出的控制項工具箱。
第三，在控制項工具箱上單擊「命令按鈕」，文檔中就放置了一個按鈕了。
第四，雙擊該按鈕，進入VB代碼編寫模式，將以下代碼復制進去。
Private Sub CommandButton1_Click()
Application.ScreenUpdating = False
Dim myPas As String, myPath As String, i As Integer, myDoc As Document
With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "選擇目標文件夾"
If .Show = -1 Then
myPath = .SelectedItems(1)
Else
Exit Sub
End If
End With
myPas = InputBox("請輸入打開密碼：")
With Application.FileSearch
.LookIn = myPath
.FileType = msoFileTypeWordDocuments
If .Execute > 0 Then
For i = 1 To .FoundFiles.Count
Set myDoc = Documents.Open(FileName:=.FoundFiles(i), Passworddocument:=myPas)
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "大家好"
.Replacement.Text = "你好"
.Forward = True
.Wrap = wdFindAsk
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchByte = True
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
myDoc.Save
myDoc.Close
Set myDoc = Nothing
Next
End If
End With
Application.ScreenUpdating = True
End Sub

第五，保存上面代碼，退出VB編輯模式，返回Word文檔界面。
第六，單擊選中該按鈕，再單擊控制項工具箱的第一個按鈕「退出設計模式」。
第七，進行測試：點擊按鈕，選擇要放置多個WORD文檔所在的文件夾，確定後即可完成！注意如果WORD文檔沒有加密的話，密碼項就不填，直接確認。就會發現該文件夾下面的所有WORD文檔中「大家好」已被替換為「你好」了。

㈣ VBA怎樣實現 批量選擇word文檔讀取其文件名並填表 的功能

SubTest()
Dimf,n,x,wb,fName

OnErrorResumeNext

Cells.Clear

'打開文件(可多選)
f=Application.GetOpenFilename("Word文件,*.docm,",1,"選擇文件",MultiSelect:=True)

'遍歷每個選擇的文件
Forx=1ToUBound(f)
sFile=f(x)

'取文件名,並賦值給單元格
n=Len(sFile)-InStrRev(sFile,"")
fName=Right(sFile,n)
Cells(x,1)=Left(fName,InStr(fName,"")-1)'取1到空格前的字元
'Cells(x,1)=Left(fname,9)'取文件名的前9個字元
Cells(x,2)=Mid(fName,InStr(fName,"")+1,Len(fName)-InStr(fName,".")+1)'取空格後到點之前的字元
'Cells(x,2)=Mid(fName,10,Len(fName)-InStr(fName,".")+1)'從10開始取到點之前的字元
Nextx

EndSub

㈤ 怎樣大量提取word的標題

具體操作步驟如下。

1、首先在word的頁面，輸入幾個標題。如下圖所示。

㈥ (VBA)怎麼提取Word中指定級 標題中正文內容

在word工具欄中找到「式樣」（就在）「字體」的旁邊，選擇「清除格式」所有標題就都沒了。就可以隨便提取了。

㈦ vba處理word獲取各級標題及內容

兩種可行的思路：
1、利用正則表達式提取；
2、利用VBA編程提取

㈧ VBA如何遍歷WORD文檔中的某一級標題

使用Find方法，看看是不是快了。
'樣式、符合樣式的當前段文本
Dim wdSty$, strTxt$
wdSty = "標題 1"
With Selection
.HomeKey unit:=wdStory, Extend:=wdMove'游標移到文檔首
.Find.ClearFormatting
.Find.Style = ActiveDocument.Styles(wdSty)'設置查找文本的樣式為wdSty(「標題1」)
End With
'循環查找文檔里所有為「標題1」樣式的段落，
Do While Selection.Find.Execute(findtext:="*^13", MatchWildcards:=True, Format:=True)
strTxt = Selection.Text '獲取符合樣式的文本
'.......在這里錄入處理代碼

Selection.Move unit:=wdWord, Count:=1
If Selection.MoveRight <> 1 Then'文檔尾退出
Exit Do
Else
Selection.MoveLeft
End If
Loop

㈨ 一個word的VBA中如何批量讀取一個文件夾裡面的word文件中的欄位

我理解你說的欄位應該是文件中一個表格中的某一個單元格
具體邏輯是這樣的
1、用scripting.filesystemobject 對象打開一個文件夾，遍歷其中的所有WORD文件
2、打開WORD文件，讀取文件中table(i) 對象的一個具體的單元格
完了。至於上面 i 的值及讀取單元格的地址，要看你具體的文件

㈩ 如何利用VBA批量提取文件夾下所有Word文檔的標題和指定段落

Sub test()
Dim fso, fp, arr, wd, f, n%, fname$
Set fso = CreateObject("scripting.filesystemobject")
Set fp = fso.getfolder(ThisWorkbook.Path)
ReDim arr(1 To fp.Files.Count, 1 To 2)
arr(1, 1) = "文件號": arr(1, 2) = "標題"
Set wd = CreateObject("word.application")
n = 1
For Each f In fp.Files
If Right(f, 3) = "doc" Or Right(f, 4) = "docx" Then
n = n + 1: arr(n, 1) = fso.getbasename(f)
fname = fso.getfilename(f)
With wd.Documents.Open(ThisWorkbook.Path & "\" & fname, True, True)
wd.Visible = True
arr(n, 2) = .Paragraphs(2).Range
.Close
End With
End If
Next
wd.Quit
Sheets(1).[a1].Resize(UBound(arr), UBound(arr, 2)) = arr
End Sub
現在有一個文件夾下有N個Word文件，要將他們的文件名和文檔內的第二段提取到Excel表格，如何通過VBA實現