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

Question

我正在尝试替换各种文档中标题中的日期。
我不在乎日期是否已经在脚本中，或者程序是否需要参数。
标题日期的格式是这样的：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 Caribbeana 中的文件。您是说在 C:\Nueva Caribbeana 中创建一个 .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

好的，这段代码改变了标题的日期并且效果很好：

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 Caribbeana 的所有 .doc 文件中执行此代码？ 问候