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.

11 komentarzy:

  1. Bardzo mi się przydało - jeśli by ktoś jeszcze dołożył pomysł jak to od razu zapisać do pdf to już byłaby pełnia szczęścia.

    OdpowiedzUsuń
    Odpowiedzi
    1. he he mamy 2019:)
      zamiast
      sFileName = w.DataSource.DataFields("c").Value & ".docx
      wpisz:
      sFileName = "C:\Users\Przemek\Documents\w\" & w.DataSource.DataFields("c").Value & ".pdf"
      ActiveDocument.SaveAs FileName:="C:\Users\Przemek\Documents\w\" & w.DataSource.DataFields("c").Value & ".docx"

      w efekcie otrzymasz 2 pliki i pdf i docx

      Usuń
  2. Gdy próbuję uruchomić makro wyświetla się komunikat "żądany  element kolekcji nie istnieje" OK  i otwiera się plik ze wszystkimi dokumentami - Katalog. Korzystam z Office 2007 na Win XP. Mam utworzony dokument korespondencji seryjnej z bazą w postaci lokalnej tabeli excela. Proszę o pomoc

    OdpowiedzUsuń
  3. Jestem absolutnie zielona jeśli chodzi o makra, a bardzo zależy mi na dwóch rzeczach. Mam przygotowany dokument korespondencji seryjnej, ma on 1200 stron..Chciałabym zapisać każdy z plików (w sumie 300 plików, po 4 strony każdy) w taki sposób, aby każdy z zapisanych przeze mnie plików miał taką samą nazwę (List od XXX_NAZWA ORGANIZACJI). Nazwa organizacji znajduje się w mojej korespondecji seryjnej.


    Czy jest to możliwe?

    OdpowiedzUsuń
  4. Mam taki sam problem jak Leo. Proszę o pomoc

    OdpowiedzUsuń
  5. Co prawda minęło trochę czasu od zapytania, ale może innym się przyda. Jeśli jest błąd "żądany element kolekcji nie istnieje" to znaczy, że coś jest źle w linijce:
    sFileName = w.DataSource.DataFields("c").Value & ".docx"

    Trzeba zmienić to "c". Należy tam wstawić w cudzysłowie nazwę kolumny z excela, który jest źródłem danych. Nie numer kolumny (a, b, c...) tylko jej nazwę np. "adres", "towar" itp.

    OdpowiedzUsuń
  6. W pętli For chyba powinno być a = 1

    For a = 1 To w.DataSource.RecordCount

    OdpowiedzUsuń
    Odpowiedzi
    1. Faktycznie "For a=1" ponieważ jak było 0 to nazwa pliku rozmijała sie z prawdą o jeden rekord.:-)
      Generalnie działa rewelacyjnie - dzięki!

      Usuń
  7. Skrypt działa super :)
    mam tylko pytanie, czy jest możliwość sortowania plików w folderach,
    Dajmy na to, mam kolumnę nazwisko, czyli tworzy ścieżkę sFileName = "D:\NAZWISKO\& w.DataSource.DataFields("Nazwisko").Value & ". doc" ?

    OdpowiedzUsuń
  8. witam

    a czy można do tego dołożyć okno dialogowe w którym określa się zakres pozycji od której do której ma wygenerować te pliki aby za każdym razem nie tworzył kilku set plików tylko te które są potrzebne

    OdpowiedzUsuń