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 SubKomentarza 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