替换各种 .doc 文档中 header 的日期

Question

我正在尝试替换各种文档中 header 中的日期。
我不在乎日期是否已经在脚本中或者程序是否需要参数。
header 日期的格式如下所示：22/02/2015 我想用相同格式替换为实际日期。
这是我完成的代码：

Sub FindAndReplaceFirstStoryOfEachType()
    Set objRegEx = CreateObject("vbscript.regexp")
    objRegEx.Global = True
    objRegEx.IgnoreCase = True
    objRegEx.MultiLine = True
  Dim rngStory As Range
  For Each rngStory In ActiveDocument.StoryRanges
    With rngStory.Find
      .Text = "([1-12]{1,3}/[1-09]{1,2}/[1-2014]{1,4})"
      .Replacement.Text = "<DATE>"
      .Wrap = wdFindContinue
      .Execute Replace:=wdReplaceAll
    End With
  Next rngStory
End Sub

我看到一个代码可以应用于地毯中的文档，但是当我使用它时它不起作用：

Set wdDoc = wdApp.Documents.Open("C:\Nueva carpeta\*.doc")

编辑：我不知道如何将我最后的代码插入另一个 vba 以打开文件夹 C:\Nueva carpeta 中的文件。你是说在 C:\Nueva carpeta 中创建一个 .doc 单词，然后创建一个带有答案代码的模块吗？但是在这个新模块中我必须调用或粘贴我的代码或什么？

Answer 1

您不能使用正则表达式作为搜索文本，您必须将搜索结果与正则表达式进行测试，然后执行替换。我还更改了正则表达式：

Sub FindAndReplaceFirstStoryOfEachType()
Set objRegEx = CreateObject("vbscript.regexp")
objRegEx.Global = True
objRegEx.IgnoreCase = True
objRegEx.MultiLine = True
objRegEx.Pattern = "[0-9]{2}/[0-9]{2}/[0-9]{4}"


Dim rngStory As Range
For Each rngStory In ActiveDocument.StoryRanges
If Not IsEmpty(rngStory) Then
With rngStory.Find
    If objRegEx.test(rngStory) = True Then

     .Text = CStr(rngStory)
     .Replacement.Text = Now()
     .Wrap = wdFindContinue
     .Execute Replace:=wdReplaceAll
    End If
End With

End If
Next rngStory
End Sub

如果您想更改当前日期的格式，可以使用

Format(now(), "mm/dd/yyyy")。另外我不确定你问题的最后一部分是否有打开文件的问题。

编辑：Open multiple documents 如果您要打开多个文档，可能会有所帮助。

您可以将以下代码放入模板文档并使用它打开您的其他文件：

Sub openf()
Dim FSO As Object
Dim fPath As String
Dim myFolder, myFile
Dim wdApp As Object
Dim wdDoc As Variant

fPath = "C:\" 'change to your directory
Set wdApp = GetObject(, "Word.Application")
Set FSO = CreateObject("Scripting.FileSystemObject")
Set myFolder = FSO.GetFolder(fPath).Files
For Each myFile In myFolder
  If LCase(myFile) Like "*.docx" Then 'change to you file type
      Set wdDoc = wdApp.Documents.Open(CStr(myFile))
      wdApp.Visible = True
      FindAndReplaceFirstStoryOfEachType
      wdDoc.Save
      wdDoc.Close
      Set wdDoc = Nothing
  End If
Next myFile

End Sub

如果您仍然对它的工作方式有疑问，我建议您阅读一些基本的 vba 编码教程：http://www.cpearson.com/Excel/MainPage.aspx

Answer 2

好的，此代码更改 header 的日期并且效果很好：

Sub ModificarFechaCabecera()

If ActiveWindow.View.SplitSpecial <> wdPaneNone Then
    ActiveWindow.Panes(2).Close
End If
If ActiveWindow.ActivePane.View.Type = wdNormalView Or ActiveWindow. _
    ActivePane.View.Type = wdOutlineView Then
    ActiveWindow.ActivePane.View.Type = wdPrintView
End If
ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
Selection.MoveRight Unit:=wdCharacter, Count:=14
Selection.MoveDown Unit:=wdLine, Count:=1
Selection.MoveRight Unit:=wdCharacter, Count:=3
Selection.MoveLeft Unit:=wdCharacter, Count:=1
Selection.Delete Unit:=wdCharacter, Count:=1
Selection.Delete Unit:=wdCharacter, Count:=1
Selection.Delete Unit:=wdCharacter, Count:=1
Selection.Delete Unit:=wdCharacter, Count:=1
Selection.Delete Unit:=wdCharacter, Count:=1
Selection.Delete Unit:=wdCharacter, Count:=1
Selection.Delete Unit:=wdCharacter, Count:=1
Selection.Delete Unit:=wdCharacter, Count:=1
Selection.Delete Unit:=wdCharacter, Count:=1
Selection.Delete Unit:=wdCharacter, Count:=1
Selection.TypeText Text:=Format(Now(), "dd/mm/yyyy")
Selection.MoveLeft Unit:=wdCharacter, Count:=4
Selection.TypeBackspace
Selection.TypeText Text:="/"
End Sub

现在，如何在目录 C:\Nueva carpeta 的所有 .doc 文件中执行这段代码？问候

替换各种 .doc 文档中 header 的日期

Replace the header's date in various .doc documents

format

vba

replace

header

find