Question

到目前为止花了一个星期试图解决这个问题，所以我不只是首先跳到这里 - 所有微软网站都倾向于关注Excel，这似乎不适合我正在做的事情：

我正在尝试使用此VBA脚本连续打开多个WORD文件，运行查找/选择以获取特定模式，然后将所有实例复制到另一个WORD文件中。

这段代码是我在网上找到的东西的混合物（尽管不记得在哪里）和我自己的修修补补。我已经能够DEBUG.PRINT正确的输出，但没有办法继续移动我的文件来复制特定的行，然后粘贴它们。我觉得它与.Activate调用有关：

Sub x()

Dim GetStr(5000) As String

Const wdStory = 4
Const wdExtend = 1

'Set Doc = Documents.Open(FileName:="C:\Users\...\filename.CDS", Visible:=True)
'Set Doc = Documents.Open("C:\Users\...\filename.CDS")

Set MyDialog = Application.FileDialog(msoFileDialogFilePicker)
With MyDialog
.Filters.Clear
.Filters.Add "All WORD File ", "*.CDS", 1
.AllowMultiSelect = True

i = 2 'set to 2 in order to offset the open word window that houses the VBA

If .Show = -1 Then
    For Each stiSelectedItem In .SelectedItems
        GetStr(i) = stiSelectedItem
        i = i + 1
    Next
    i = i - 1
End If

Set objWord = CreateObject("Word.Application")
objWord.Visible = True
objWord.Documents.Open ("C:\Users\...\filename.docx")

For j = 2 To i Step 1

Set objDoc = objWord.Documents.Open(GetStr(j))
'Debug.Print (objWord.Documents(1).Name)

Set objSelection = objWord.Selection

objSelection.Find.Forward = True
objSelection.Find.MatchWildcards = True
objSelection.Find.Text = "DEFINE"

Do While True

    objSelection.Find.Execute
    Debug.Print (objSelection)
    If objSelection.Find.Found Then
        objSelection.EndOf wdStory, wdExtend     'get selection
        strText = objSelection.Copy              'strText = selection copied to clipboard, no value     (like an inline function)
        Set selectionToPaste = objWord.Selection 'selectionToPaste is literally the clipboard
        'objWord.Documents(2).Activate
        'Debug.Print ("->'Activated Window': " + objWord.ActiveDocument.Name)
        'Debug.Print ("selectionToPaste = " + selectionToPaste)
        selectionToPaste.Paste
        'objWord.Documents(1).Activate
        objSelection.Find.Execute
    Else
        objWord.ActiveDocument.Save
        objWord.ActiveWindow.Close
        Exit Do
    End If

Loop

Next

End With

End Sub

Answer 1

OP在这里 - 利用循环解决了我自己的问题。

Sub x()

Dim GetStr(5000) As String
**Dim iCounter As Integer**
Const wdStory = 4
Const wdExtend = 1

'Set Doc = Documents.Open(FileName:="C:\Users\...\filename.CDS", Visible:=True)
'Set Doc = Documents.Open("C:\Users\...\filename.CDS")

Set MyDialog = Application.FileDialog(msoFileDialogFilePicker)
With MyDialog
.Filters.Clear
.Filters.Add "All WORD File ", "*.CDS", 1
.AllowMultiSelect = True

i = 2 'set to 2 in order to offset the open word window that houses the VBA

If .Show = -1 Then
    For Each stiSelectedItem In .SelectedItems
        GetStr(i) = stiSelectedItem
        i = i + 1
    Next
    i = i - 1
End If

Set objWord = CreateObject("Word.Application")
objWord.Visible = True
objWord.Documents.Open ("C:\Users\lidm3b2\Desktop\gar\2.docx")

For j = 2 To i Step 1

Set objDoc = objWord.Documents.Open(GetStr(j))
'Debug.Print (objWord.Documents(1).Name)

Set objSelection = objWord.Selection

objSelection.Find.Forward = True
objSelection.Find.MatchWildcards = True
objSelection.Find.Text = "DEFINE"

**iCounter = 0**

Do While True
    **For iLoopCounter = 0 To iCounter Step 1
        objSelection.Find.Execute
    Next**
    Debug.Print (objSelection)
    If objSelection.Find.Found Then
        objSelection.EndOf wdStory, wdExtend     'get selection
        strText = objSelection.Copy              'strText = selection copied to clipboard, no value (like an inline function)
        Set selectionToPaste = objWord.Selection 'selectionToPaste is literally the clipboard
        objWord.Documents(2).Activate
        'Debug.Print ("->'Activated Window': " + objWord.ActiveDocument.Name)
        'Debug.Print ("selectionToPaste = " + selectionToPaste)
        objWord.Selection.Paste
        objWord.Documents(1).Activate
    **iLoopCounter = iLoopCounter + 1**
        objSelection.Find.Execute
    Else
        objWord.ActiveDocument.Save
        objWord.ActiveWindow.Close 'have to close for the hardcode on "...Documents(1)..." and 2 to work.
        Exit Do
    End If

Loop

Next

End With

End Sub

在多个Word 2013文档中查找与REGEX匹配的所有字符串，并粘贴到单个特定的Word 2013文档中

1 个答案: