Korespondencja seryjna z punktu widzenia VBA

W dzisiejszym odcinku przedstawiam makro generujące dokument Word-a na podstawie szablonu. Makro takie można wykorzystać np. z poziomu Excel-a lub Access-a do automatyzacji korespondencji seryjnej . Parametryzacji ewentualnie wymagały by parametry będące w stringach tekstowych.

Sub generuj_dokument()
    
    ' deklaracje zmiennych, może być potrzebna referencja w projekcie
    Dim w As Word.Application
    Dim d As Word.Document
    Dim nd As Word.Document
    Dim m As Word.MailMerge
    Dim wAllert As Word.WdAlertLevel
    
    Dim sConn As String
    Dim sComm As String
    Dim sFile As String
    Dim sFileOut As String
    Dim sDefaultDir As String
    Dim sTemplate As String
    Dim sPass As String

    sComm = "SELECT * FROM `Arkusz1$`" 'zapytanie sql z którego korzystamy
    sPass = "xxxxxxxx" ' hasło do pliku template
    sDefaultDir = "C:\Users\user\Documents\" ' katalog domyślny dla operacji
    sTemplate = sDefaultDir & "dokument.docx" ' plik szablonu
    sFileData = sDefaultDir & "dane.xlsx" ' plik z danymi
    sFileOut = sDefaultDir & "dane_out.docx" ' plik wyjściowy
    
    ' connection String, w tym przypadku dla Excel-a 12
    sConn = ""
    sConn = "Provider=Microsoft.ACE.OLEDB.12.0;User ID=Admin;Data Source=" & sFileData & ";Mode=Read;Extended Properties=""HDR=YES;IMEX=1;"";Jet OLEDB:System database="""";Jet OLEDB:Registry Path="""";Jet OLEDB:Engine Type=37;Jet OLEDB:Database Locki"

    On Error Resume Next
    
    ' istniejący obiekt
    Set w = GetObject(, "Word.Application")
     
    If Err.Number <> 0 Then
        ' nowy obiekt
        Set w = CreateObject("Word.Application")
    End If

    ' wyłączenie alertu o pobieraniu danych
    wAllert = w.DisplayAlerts
    w.DisplayAlerts = wdAlertsNone
    Set d = w.Documents.Open( _
            FileName:=sTemplate, _
            PasswordDocument:=sPass)
    w.DisplayAlerts = wAllert
    Set m = d.MailMerge

    With m
        .OpenDataSource _
                Name:=sFileData, _
                SQLStatement:=sComm, _
                SubType:=wdMergeSubTypeAccess, _
                Connection:=sConn
        .Destination = wdSendToNewDocument
        If .State = wdMainAndDataSource Then
            .Execute
        Else
            MsgBox "problem w wypełnieniu dokumentu"
            Exit Sub
        End If
    End With

    ' obiekt nowo utworzonego dokumentu po wypełnieniu
    Set nd = ActiveDocument
    
    With nd
        .SaveAs _
                FileName:=sFileOut, _
                FileFormat:=wdFormatXMLDocument
        .Close
    End With
    
    d.Close False
    w.Quit
    
    Set nd = Nothing
    Set d = Nothing
    Set w = Nothing

End Sub

I taka mała uwaga na koniec. Plik Excel-a z którego korzystamy powinien być zamknięty na czas kiedy korzystamy z makra.