Question

我试图在各种文件中替换标题中的日期我不在乎它已经在剧本中的日期，或者程序是否需要参数标题日期的格式与此类似：2015年2月22日，我想用相同的格式替换实际日期。
这是我所做的代码：

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

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

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文档中替换标题的日期

2 个答案: