如何使Microsoft Word的宏生成多个文档？

Posted 2021-05-01

我有一个我一直在研究的宏，它从另一个程序获取数据，然后将所有数据“打印”到Word文档中。哪个好，但我想让宏创建多个文档。

我有一个另一个宏的例子，我的一位同事写过这样做的事情，但是对于我正在使用的不同信息。

有人可以帮我弄清楚如何在MY宏中获得相同的功能吗？

具有多个文档的示例宏：

这是已经有效的宏，一位同事做了：

Sub state()
Dim strTempF41 As String
Dim strDateType As String
Dim strDate As String
Dim strPolicyType As String
Dim transNoStarts As Integer
Dim individualStatements, strText As String
Dim numStatements, msgResponse As Integer
Dim intPosition As Integer


g_strDirectoryPolicy = g_strUserNetDrive
g_strFilenameDestination = "state.doc"
g_strDest = g_strDirectoryPolicy & g_strFilenameDestination
g_strFilenameSource = g_strCompanyPrefix & "_dum_state.doc"
g_strSource = g_strDummyDir & g_strFilenameSource

If g_arrFNumbers(13) = "T" Then
    g_strSource = chkDotDoc(g_arrFNumbers(14) & ".doc")
    g_strFilenameSource = chkDotDoc(g_arrFNumbers(14) & ".doc")
        Do
            intPosition = InStr(1, g_strFilenameSource, "\")
            If (intPosition > 0) Then
                g_strFilenameSource = Mid$(g_strFilenameSource, intPosition + 1)
            End If
        Loop Until intPosition = 0
End If

'URM7370 This does the merge to individual statements, but it has been agreed that this will not be used yet
' Changes need to be added to form to have a Y/N flag in F21

If individualStatementsEnabled = True Then
    individualStatements = "Y"      'set to g_arrFNumbers(21)
    g_arrFNumbers(21) = "Y"
Else
    individualStatements = "N"
    g_arrFNumbers(21) = "N"
End If

g_LastDocument = False

g_lastPartner = ""
g_LastPartnerRecord = 0
numStatements = 0
If g_arrFNumbers(21) <> "Y" Then
    g_LastDocument = True
End If

    Do
        If fileDoesExist(g_strSource) Then
            Documents.Open fileName:=g_strSource, READONLY:=False, AddToRecentFiles:=True, PasswordDocument:="", _
            PasswordTemplate:="", Revert:=False, WritePasswordDocument:="", WritePasswordTemplate:="", _
            Format:=wdOpenFormatAuto
        Else
            eventMsg ("eventMsg 101 state:" & vbCrLf & "File " & g_strSource & " does not exist.")
        End If

        numStatements = numStatements + 1
        Merge

        'This saves the file as a PDF and then will send an email (with the doc file attached)
        'Will never go throgh this code at the moment as option hasn't been released
        If individualStatements = "Y" Then
            'If 2010 or above, save as PDF
            If g_strWordVers = "2010" Or g_strWordVers = "2013" Or g_strWordVers = "Post 2013" Then
                g_strFilenameDestination = "state_" & g_lastPartner & ".pdf"
                g_strDest = g_strDirectoryPolicy & g_strFilenameDestination
                ActiveDocument.SaveAs2 fileName:=g_strDest, FileFormat:=wdFormatPDF

                        'eventMsg ("eventMsg 110 state: Request to send email found in PC.CSV for PROFSCHED file.")
                        'Dim strEmail As String
                        'Dim strCompany As String
                        'Dim strCopyFile As String
                        'strEmail = g_arrFNumbers(22)
                        'strCompany = g_arrFNumbers(1)
                        'strCopyFile = g_strDest

                        'strText = "Do you wish to send an email with the statement for " & g_lastPartner
                        'If MsgBox(strText, vbYesNo) = vbYes Then
                        '    eventMsg ("eventMsg 113 state: Attempting to send email directly to " & strEmail)
                        '    ActiveDocument.SendMail
                        '    eventMsg ("eventMsg 114 state: Email request complete.")
                        'End If
                End If
                'Keep the documents open for the moment - may need to look again if too may open
               'ActiveDocument.Close

        End If

        If g_LastDocument = True Then
            eventMsg ("eventMsg 103 state: All statements completed, total  " & numStatements)
            Exit Do
        Else
            g_arrFNumbers(21) = individualStatements
            LoadPCCSV ("pc.csv")
            g_arrFNumbers(21) = individualStatements
            eventMsg ("eventMsg 102 state: Merge for partner " & g_lastPartner)
        End If

    Loop Until g_LastDocument = True    'last record is false so must be more partners


    'ActiveDocument.Saved = True
    If individualStatements = "Y" Then
        strText = "All statements complete, total " & numStatements
        MsgBox strText, vbOKOnly
    End If


    MakeWordVisible
    MacroFinish

    End

End Sub

这是我需要帮助的宏：

    Sub closings()
Dim strFileToInsert As String

g_strFilenameDestination = "closings" & g_arrFNumbers(7)
g_strDest = g_strDirectoryPolicy & g_strFilenameDestination & ".doc"

g_strFilenameSource = g_strCompanyPrefix & "_dum_closings.doc"
g_strSource = g_strDummyDir & g_strFilenameSource

eventMsg ("eventMsg 101 closings: Source = " & g_strSource & ", destination = " & g_strDest)

If g_arrFNumbers(13) = "C" Then
    deleteFile (g_strDest)

    If fileDoesExist(g_strSource) Then
        Documents.Open fileName:=g_strSource, ConfirmConversions:=False, READONLY:=False, _
            AddToRecentFiles:=True, PasswordDocument:="", PasswordTemplate:="", Revert:=False, _
            WritePasswordDocument:="", WritePasswordTemplate:="", Format:=wdOpenFormatAuto
    Else
        displayErr "eventMsg 102 closings: File " & g_strSource & " does not exist.", "C", True
    End If

    If g_arrFNumbers(16) <> "" Then
        eventMsg ("eventMsg 103 closings: Inserting " & g_arrFNumbers(16))

        'Navigate to fill field f31 (Transaction) ready for insertion..
        Selection.Find.ClearFormatting

        findText ("f31")
        Selection.MoveDown Unit:=wdLine, Count:=1

        strFileToInsert = g_strDirectoryWP & g_arrFNumbers(16)
        If fileDoesExist(strFileToInsert) Then
            Selection.InsertFile fileName:=strFileToInsert, Range:="", Link:=False, Attachment:=False
        Else
            displayErr "eventMsg 104 closings: File " & strFileToInsert & " does not exist.", "C", True
        End If
    End If

    If g_arrFNumbers(17) <> "" Then
        eventMsg ("eventMsg 105 closings: Inserting " & g_arrFNumbers(17))
        GoToEnd
        strFileToInsert = g_strUserNetDrive & g_arrFNumbers(17)

        If fileDoesExist(strFileToInsert) Then
            Selection.InsertFile fileName:=strFileToInsert, Range:="", Link:=False, Attachment:=False
        Else
            displayErr "eventMsg 106 closings: File " & strFileToInsert & " does not exist.", "C", True
        End If
    End If

    eventMsg ("eventMsg 107 closings: Merging to " & g_strDest)

    'This does the merge... to g_strDest
    Merge

    GoToStart
    ActiveDocument.Saved = True

End If

If g_arrFNumbers(13) = "E" Then

    'Open the g_strDest file..
    If fileDoesExist(g_strDest) Then
        Documents.Open fileName:=g_strDest, READONLY:=False, AddToRecentFiles:=False, PasswordDocument:="", _
            PasswordTemplate:="", Revert:=False, WritePasswordDocument:="", WritePasswordTemplate:="", _
            Format:=wdOpenFormatAuto
    Else
        displayErr "eventMsg 108 closings: File " & g_strDest & " does not exist.", "E", True
    End If
End If

MakeWordVisible
MacroFinish
End

End Sub

答案

首先，添加一个Document变量：

Dim MyDoc as Document

然后，当您打开文档时，请确保使用该变量：

Set MyDoc = Documents.Open...

然后用MyDoc替换每个ActiveDocument。现在，您可以同时处理更多文档（通过创建更多文档变量），同时使其更加健壮。接下来要删除的是选择。

另一答案

似乎我只是做错了。我需要做的就是将第一个宏的功能复制并粘贴到第二个宏中并更改几个关键词。

如果这个问题浪费在任何人的时间，请道歉。

编辑：我仍然是这项工作的新手，我一定会犯错误，所以谢谢Sam对我的耐心。