Kako paketno ekstrahirati vse zaznamke iz vašega Wordovega dokumenta

V današnjem članku bi radi z vami delili korake za skupinsko ekstrahiranje vseh zaznamkov iz Wordovega dokumenta, da si jih ogledate hkrati.

V Wordu lahko z vgrajeno funkcijo ustvarite kazalo ali kazalo slik. Toda na koncu boste ugotovili, da ni običajnega načina za ekstrahiranje vseh zaznamkov dokumenta in njihovo razporeditev v nov dokument.

Kot vedno je naše poslanstvo, da vas vodimo skozi mit in vam zagotovimo makro način za izvoz vseh zaznamkov in njihovih besedil v nov prazen dokument.

Paketno ekstrahiranje vseh zaznamkov iz enega samega dokumenta

1. Za začetek odprite ciljni dokument in pritisnite »Alt + F11«, da zaženete urejevalnik VBA.
2. Nato kliknite »Običajno« in nato »Vstavi«.
3. In izberite »Modul«, da ustvarite novega pod projektom »Normal«.
4. Nato dvokliknite nanj, da prikažete prostor za urejanje.
5. Tam prilepite naslednji makro:

Sub ExtractBookmarksInADoc()
  Dim objBookmark As Bookmark
  Dim objTable As Table
  Dim nRow As Integer
  Dim objDoc As Document, objNewDoc As Document
  Dim objParagraph As Paragraph
 
  Set objDoc = ActiveDocument
 
  If objDoc.Bookmarks.Count = 0 Then
    MsgBox ("There is no bookmark in this document.")
  Else
    Set objNewDoc = Documents.Add
 
    Selection.TypeText Text:="Bookmarks in " & "'" & objDoc.Name & "'"
 
    Set objTable = Selection.Tables.Add(Range:=Selection.Range, numrows:=1, numcolumns:=3)
    objTable.Borders.Enable = True
    nRow = 1
 
    For Each objParagraph In objNewDoc.Paragraphs
      If objParagraph.Range.Style = "Caption" Then
        objParagraph.Range.Delete
      End If
    Next objParagraph
 
    With objTable
      .Cell(1, 1).Range.Text = "Name"
      .Cell(1, 2).Range.Text = "Texts"
      .Cell(1, 3).Range.Text = "Page Number"
 
      For Each objBookmark In objDoc.Bookmarks
        objTable.Rows.Add
        nRow = nRow + 1
        .Cell(nRow, 1).Range.Text = objBookmark.Name
        .Cell(nRow, 2).Range.Text = objBookmark.Range.Text
        .Cell(nRow, 3).Range.Text = objBookmark.Range.Information(wdActiveEndAdjustedPageNumber)
        objDoc.Hyperlinks.Add Anchor:=.Cell(nRow, 3).Range, Address:=objDoc.Name, _
          SubAddress:=objBookmark.Name, TextToDisplay:=.Cell(nRow, 3).Range.Text
      Next objBookmark
    End With
  End If
  objNewDoc.SaveAs2 FileName:=objDoc.Path & "\" & "Bookmarks in " & objDoc.Name
End Sub

6. Nenazadnje kliknite »Zaženi«.

Vsi zaznamki trenutnega dokumenta bodo postavljeni v tabelo novega dokumenta, shranjenega v istem imeniku kot izvirna datoteka.

V novem dokumentu si lahko ogledate tabelo s 3 stolpci. In če sledite »Ctrl + klik«, vas bo pripeljal do zaznamka v izvirnem dokumentu.

Paketno ekstrahiranje zaznamkov iz več dokumentov

Za namestitev in zagon makra sledite istim korakom zgoraj. Samo tokrat zamenjate kode s spodnjimi:

Sub ExtractBookmarksInMultiDoc()
  Dim objBookmark As Bookmark
  Dim objTable As Table
  Dim nRow As Integer
  Dim objDoc As Document, objNewDoc As Document
  Dim objParagraph As Paragraph
  Dim strFolder As String, strFile As String
 
  strFolder = InputBox("Enter folder path here: ")
  strFile = Dir(strFolder & "*.docx", vbNormal)
 
  While strFile <> ""
    Set objDoc = Documents.Open(FileName:=strFolder & strFile)
    Set objDoc = ActiveDocument
    Set objNewDoc = Documents.Add
 
    Selection.TypeText Text:="Bookmarks in " & "'" & objDoc.Name & "'"
 
    Set objTable = Selection.Tables.Add(Range:=Selection.Range, numrows:=1, numcolumns:=3)
    objTable.Borders.Enable = True
    nRow = 1
 
    For Each objParagraph In objNewDoc.Paragraphs
      If objParagraph.Range.Style = "Caption" Then
        objParagraph.Range.Delete
      End If
    Next objParagraph
 
    With objTable
      .Cell(1, 1).Range.Text = "Name"
      .Cell(1, 2).Range.Text = "Texts"
      .Cell(1, 3).Range.Text = "Page Number"
 
      For Each objBookmark In objDoc.Bookmarks
        objTable.Rows.Add
        nRow = nRow + 1
        .Cell(nRow, 1).Range.Text = objBookmark.Name
        .Cell(nRow, 2).Range.Text = objBookmark.Range.Text
        .Cell(nRow, 3).Range.Text = objBookmark.Range.Information(wdActiveEndAdjustedPageNumber)
        objDoc.Hyperlinks.Add Anchor:=.Cell(nRow, 3).Range, Address:=objDoc.Name, _
          SubAddress:=objBookmark.Name, TextToDisplay:=.Cell(nRow, 3).Range.Text
      Next objBookmark
    End With
    objNewDoc.SaveAs2 FileName:=objDoc.Path & "\" & "Bookmarks in " & objDoc.Name
    objDoc.Close
    strFile = Dir()
  Wend
End Sub

Ko zaženete makro, se prikaže polje za vnos. Vnesite pot do mape, kamor shranjujete vse dokumente. In ne pozabite dodajte “\” na koncu poti če ga preprosto kopirate iz besedilnega polja mape. Nato kliknite »V redu«.

Kako se hitro rešiti pred podatkovno katastrofo

Podatkovna katastrofa, o kateri govorimo v Wordu, se lahko zgodi vsakič, ko preneha delovati nenormalno. Včasih imate srečo in imate vse informacije nedotaknjene. In drugič postaneš žrtev nesreče. Zato je najhitrejši način za pridobivanje čim več podatkov ta, da pridobite orodje za popraviti docx.

Uvod avtorja:

Vera Chen je strokovnjakinja za obnovitev podatkov v DataNumen, Inc., ki je vodilna na svetu na področju tehnologij za obnovitev podatkov, vključno z popravilo xlsx in pdf popravilo programskih izdelkov. Za več informacij obiščite www.datanumen.com