使用VBA查找和替换Word文档中的日期

时间:2017-08-16 16:56:07

标签: vba ms-word word-vba

我在查找Word文档文本中“2017年8月16日”格式的任何日期时遇到问题。使用ActiveDocument.Content.Find,我只能在第一页上找到结果。即使在第一页内,结果也不一致。以下是我的代码。

Dim myMonth(1 To 12) As String
myMonth(1) = "January"
myMonth(2) = "February"
myMonth(3) = "March"
myMonth(4) = "April"
myMonth(5) = "May"
myMonth(6) = "June"
myMonth(7) = "July"
myMonth(8) = "August"
myMonth(9) = "September"
myMonth(10) = "October"
myMonth(11) = "November"
myMonth(12) = "December"

'Find and replace dates in MMMM dd, yyyy format
For i = 12 To 1 Step -1
    With ActiveDocument.Content
    With .Find
        .Text = "(" & myMonth(i) & ")" & " ([0-9]{1,2}), ([0-9]{4})"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindStop
        .MatchWildcards = True
    End With

    While .Find.Execute
        .Text = CDate(.Text) + 7
        .Text = Format(.Text, "mmmm d, yyyy")

    Wend
        .Find.MatchWildcards = False
    End With

    Next i

此代码以所述格式添加7天到任何日期。我试过循环遍历所有故事,结果是一样的。我已经能够以“08/16/2017”格式执行此任务的日期,所以问题似乎在于每个月的额外For循环。任何帮助将不胜感激。

1 个答案:

答案 0 :(得分:0)

试试这段代码

Sub findMe()

    Dim aaa As Find
    Dim i As Integer

    For i = 1 To 12
        Debug.Print MonthName(i)

        Set aaa = ActiveDocument.Range(Start:=1, End:=1).Find    ' start at beginning of document

        aaa.ClearFormatting
        aaa.Replacement.ClearFormatting

        aaa.Forward = True
        aaa.Wrap = wdFindStop
        aaa.Format = False
        aaa.MatchCase = False
        aaa.MatchWholeWord = False
        aaa.MatchAllWordForms = False
        aaa.MatchSoundsLike = False
        aaa.MatchWildcards = True
        aaa.Replacement.Text = ""

        ' search text starts with any character so that upper case and lower case words are found .... july July
        aaa.Text = "?" & Mid(MonthName(i), 2, 20) & "[ ^t]{1,5}([0-9]{1,2}),[ ^t]{1,5}([0-9]{4})"

        Do While True
            DoEvents
            If Not aaa.Execute Then Exit Do                    ' find next

            Debug.Print aaa.Parent.Text                        ' found text 
            Debug.Print Format(aaa.Parent.Text, "mm/dd/yy")    ' reformat date
            Debug.Print DateAdd("d", 7, aaa.Parent.Text)       ' add 7 days
            Debug.Print Format(DateAdd("d", 7, aaa.Parent.Text), "mmmm dd, yyyy")

            ' aaa.Parent is the range object of the found text
            ' so you can do this ...
            aaa.Parent.Text = Format(DateAdd("d", 7, aaa.Parent.Text), "mm/dd/yy")
            aaa.Parent.Collapse Direction:=wdCollapseEnd           ' point to "just after replaced text"

        Loop
    Next i
End Sub