Word VBA to find line starting with “Date:” and copy line to top of respective page

问题

I'm new to VBA for Word (have used it a fair bit in Excel). I am trying to organise large word documents that contain copied and pasted emails. I want to find the date/time of each email and copy and paste it to the top of the page. All lines containing the date start with "Date:" so it is easy enough to find them. I wrote a code to try and copy them to the tops of pages but it currently pastes all of the date lines to the top of the document. I can see why, I just can't work out how to change it.

What I will then be able to do is make the first line of each page into a heading which I can sort by.

My initial code is as follows:

Sub Copy_Dates_to_Top()
If Selection.StoryType <> wdMainTextStory Then
    With ActiveDocument.ActiveWindow.View
        .Type = wdPrintView
        .SeekView = wdSeekMainDocument
    End With
End If

Selection.HomeKey Unit:=wdStory
With Selection.Find
    .Text = "Date: "
    .Format = False
    .Forward = True
    .MatchWildcards = False
    .Wrap = wdFindStop
    While .Execute
        Selection.Expand Unit:=wdLine
        Selection.Copy ' Unit:=wdLine
        Selection.GoTo What:=wdGoToBookmark, Name:="\Page"
        Selection.MoveLeft Unit:=wdCharacter, Count:=1
        Selection.Paste
    Wend
End With
End Sub

回答1:

You can achieve this quite easily by applying a unique Style to the dates, then referencing that Style via a STYLEREF field in the page header. For example, the following macro employs Word's built-in 'Strong' character Style for this.

Sub Demo()
Application.ScreenUpdating = False
With ActiveDocument
  With .Range.Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Text = "Date: [0-9]{1,2}/[0-9]{1,2}/[0-9]{4}"
    .Replacement.Text = "^&"
    .Forward = True
    .Format = True
    .Replacement.Style = "Strong"
    .Wrap = wdFindContinue
    .MatchWildcards = True
    .Execute Replace:=wdReplaceAll
  End With
  .Fields.Add Range:=.Sections.First.Headers(wdHeaderFooterPrimary).Range, _
    Type:=wdFieldEmpty, Text:="STYLEREF Strong", PreserveFormatting:=False
End With
Application.ScreenUpdating = True
End Sub

Word's 'Strong' Style applies bold formatting, which make the dates stand out more in the document body also.

Note: The macro assumes your dates are in either a d/m/y or m/d/y format; the Find expression could be changed to match a different date format.

来源：https://stackoverflow.com/questions/52645174/word-vba-to-find-line-starting-with-date-and-copy-line-to-top-of-respective-p

标签

vba

ms-word