Strony

piątek, 19 lutego 2010

Masowy zapis z korespondencji seryjnej

Korespondencja seryjna to świetny wynalazek. Niesamowicie ułatwia życie, gdy np. chcemy wygenerować i wydrukować kilkaset listów. W momencie jednak gdy chcemy tylko wygenerować i zapisać jako pliki te dokumenty stajemy przed ścianą.

Prostym rozwiązaniem tej niedogodności jest to oto makro
Sub Generuj_i_Zapisz()

    Dim w As MailMerge
    Dim a As Long
    Dim sFileName As String

On Error GoTo ERR_Handler

    Application.ScreenUpdating = False
    Application.Visible = False
    
    Set w = ActiveDocument.MailMerge

    w.DataSource.ActiveRecord = wdFirstDataSourceRecord

    For a = 0 To w.DataSource.RecordCount

        With w
            .Destination = wdSendToNewDocument
            .SuppressBlankLines = True
            With .DataSource
                .FirstRecord = a
                .LastRecord = a
            End With
            .Execute Pause:=False
            
        End With
      
        ' składamy nazwę pliku z jakiś elementów np. z kolumn źródła danych
        sFileName = "C:\Users\Przemek\Documents\w\" & w.DataSource.DataFields("c").Value & ".docx"
        
        ActiveDocument.Parent.ScreenUpdating = False
        ActiveDocument.SaveAs _
            FileName:=sFileName, _
            FileFormat:=wdFormatXMLDocument, _
            LockComments:=False, _
            Password:="", _
            AddToRecentFiles:=True, _
            WritePassword:="", _
            ReadOnlyRecommended:=False, _
            EmbedTrueTypeFonts:=False, _
            SaveNativePictureFormat:=False, _
            SaveFormsData:=False, _
            SaveAsAOCELetter:=False
        ActiveWindow.Close
    
        w.DataSource.ActiveRecord = wdNextRecord
    
    Next
    
END_Handler:

    Application.Visible = True
    Application.ScreenUpdating = True
    
    Exit Sub

ERR_Handler:
    
    MsgBox Err.Description
    
    Resume END_Handler:
    
End Sub

Komentarza w zasadzie wymagać może tylko linia
sFileName = w.DataSource.DataFields("c").Value & ".docx"
gdzie DataFields("c") to nazwa kolumny ze źródła danych - w przypadku danych użytkownika trzeba to zmienić lub użyć własnego kodu VBA. Ewentualnie zamiast nazwy możemy podać numer obiektu w kolekcji.

0 komentarze:

Prześlij komentarz

Share it

SyntaxHighlighter