Как добавить другой документ в письмо слияния для той же записи - PullRequest
1 голос
/ 20 октября 2019

Используя код, который я нашел здесь, размещенный пользователем dandarii, я могу отправить word.doc по почте. Когда это слияние будет завершено, я хочу отправить отдельное word.doc с той же записью. Я не хочу объединять два word.doc в один word.doc

. Я думал о создании отдельного модуля, но запутался. Думал о том, чтобы подписать wdDoc и wdDoc1?

With wdApp
        .Visible = False

        Set wdDoc = .Documents.Open(filePath & firstDoc)

        'Added Code
        strWorkbookName = ThisWorkbook.Path & "\" & ThisWorkbook.Name

        wdDoc.MailMerge.MainDocumentType = wdFormLetters

        wdDoc.MailMerge.OpenDataSource _
            Name:=strWorkbookName, _
            AddToRecentFiles:=False, _
            Revert:=False, _
            Format:=wdOpenFormatAuto, _
            Connection:="Data Source=" & strWorkbookName & ";Mode=Read", _
            SQLStatement:="SELECT * FROM [Sheet1$]"

        With wdDoc.MailMerge
            .Destination = wdSendToNewDocument
            With .DataSource
                .FirstRecord = loopRow - 1
                .LastRecord = loopRow - 1
                .ActiveRecord = loopRow - 1

            End With
            .Execute Pause:=False
        End With

        wdApp.Visible = False

        Set TargetDoc = wdApp.ActiveDocument

        TargetDoc.SaveAs2 Filename:=newFilePath & "\" & newFolderName & "- firstDoc.docx"

        wdDoc.Close SaveChanges:=False```

1 Ответ

0 голосов
/ 21 октября 2019

Если я правильно выполняю требование, я думаю, что было бы целесообразно разделить его на две процедуры: одну для обработки цикла (не видно в коде в вопросе), другую для обработки слияния. Что-то вроде фрагментов кода ниже.

Процедура «верхнего уровня», которая обрабатывает цикл и все, что Excel (извлечение кода, на основе содержимого, о котором идет речь):

With wdApp
    .Visible = False

    Set wdDoc = .Documents.Open(filePath & firstDoc)
    Set wdDoc1 = .Documents.Open(filePath & otherDoc)

    'Added Code
    strWorkbookName = ThisWorkbook.Path & "\" & ThisWorkbook.Name

    ExecuteMailMerge wdDoc, strWorkbookName, loopRow, _
                     newFilePath, newFolderName, firstDoc

    ExecuteMailMerge wdDoc1, strWorkbookName, loopRow, _
                     newFilePath, newFolderName, otherDoc

Процедура обработки слияния :

Sub ExecuteMailMerge(wdDoc As Object, strWorkbookName as String, loopRow as Long, _
                     newFilePath as String, newFolderName as String, docName as String)

    With wdDoc.MailMerge
        .MainDocumentType = wdFormLetters
        .OpenDataSource _
          Name:=strWorkbookName, _
          AddToRecentFiles:=False, _
          Revert:=False, _
          Format:=wdOpenFormatAuto, _
          Connection:="Data Source=" & strWorkbookName & ";Mode=Read", _
          SQLStatement:="SELECT * FROM [Sheet1$]"

        .Destination = wdSendToNewDocument
        With .DataSource
            .FirstRecord = loopRow - 1
            .LastRecord = loopRow - 1
            .ActiveRecord = loopRow - 1
        End With
        .Execute Pause:=False
    End With
    Set TargetDoc = wdApp.ActiveDocument

    TargetDoc.SaveAs2 Filename:=newFilePath & "\" & newFolderName & "- " & docName & ".docx"

    wdDoc.Close SaveChanges:=False
End Sub
...