#1
|
|||
|
|||
Save automatic Mail Merge with excel table as attachment
Hello everyone,
im using a macro to save automaticly the individual documents of a mail merge (in this case bill's) and save it in a ".docx"-format. I found a code for saving the mail merge documents individually and tried to edit it to attach an excel-table to the bill's. The macro im using is this(some words are german, i'm sorry for that): Code:
Sub WORDspeichern() ' set variables Dim iBrief As Integer, sBrief As String Dim AppShell As Object Dim BrowseDir As Variant Dim Path As String Dim sPath As Variant i = 0 ' catch any errors On Error GoTo ErrorHandling ' determine path Set AppShell = CreateObject("Shell.Application") Set BrowseDir = AppShell.BrowseForFolder(0, "Speicherort für Serienbriefe auswählen", 0, (strStartPath)) If BrowseDir = "Desktop" Then Path = sPath = CreateObject("WScript.Shell").SpecialFolders("Desktop") Else Path = BrowseDir.items().Item().Path sPath = Path End If If Path = "" Then GoTo ErrorHandling Path = Path & "Rechnungen-" & Format(Now, "dd.mm.yyyy-hh.mm.ss") & "" MkDir Path On Error GoTo ErrorHandling ' hide application for better performance MsgBox "Rechnungen werden einzeln als WORD-Dateien exportiert!", vbOKOnly + vbInformation ' Application.Visible = False ' create bulkletter and export as pdf With ActiveDocument.MailMerge .DataSource.ActiveRecord = 1 Do .Destination = wdSendToNewDocument .SuppressBlankLines = True With .DataSource .FirstRecord = .ActiveRecord .LastRecord = .ActiveRecord sBrief = Path & "2020-" & .DataFields("RECHNUNG").Value & ".doc" End With .Execute Pause:=False Call CreateAnlage(sPath) If .DataSource.DataFields("RECHNUNG").Value > "" Then ActiveDocument.SaveAs FileName:=sBrief End If ActiveDocument.Close False If .DataSource.ActiveRecord < .DataSource.RecordCount Then .DataSource.ActiveRecord = wdNextRecord Else Exit Do End If Loop End With ' error handling ErrorHandling: Application.Visible = True If Err.Number = 76 Then MsgBox "Der ausgewählte Speicherort ist ungültig", vbOKOnly + vbCritical ElseIf Err.Number = 5852 Then MsgBox "Das Dokument ist kein Serienbrief" ElseIf Err.Number = 4198 Then MsgBox "Der ausgewählte Speicherort ist ungültig", vbOKOnly + vbCritical ElseIf Err.Number = 91 Then MsgBox "Exportieren von Rechnungen abgebrochen", vbOKOnly + vbExclamation ElseIf Err.Number > 0 Then MsgBox "Unbekannter Fehler: " & Err.Number & " - Bitte Makro erneut ausführen.", vbOKOnly + vbCritical Else MsgBox "Rechnungen erfolgreich exportiert", vbOKOnly + vbInformation End If End Sub Sub CreateAnlage(sPath As Variant) Dim rng As Range Set rng = Selection.Bookmarks("Page").Range rng.SetRange rng.End, rng.End rng.Select 'Selection.InsertBreak Type:=wdPageBreak Selection.Orientation = wdTextOrientationVertical Set rng = Nothing Call importFromExcel(sPath) End Sub Private Function importFromExcel(sPath As Variant) Dim exTab As Object Dim strPath As String Dim strPath2 As String Dim rngPrintArea As Excel.Range Dim iRow, iColumn As Integer Dim einfuegeBereich As Range Dim WordTable As Word.Table iNr = 20373 + i strPath = "C:UsersEA.AliciDocumentsTabelleUbersicht2.xlsx" strPath2 = sPath & "anlagen_excel" & iNr & ".xlsx" i = i + 1 Set exTab = CreateObject("excel.application") 'exTab.workbooks.Open strPath exTab.Workbooks.Open strPath2 exTab.Visible = True 'exTab.WorkSheets("Liste Programme und Computer").Activate exTab.Worksheets("AnlagenTab").Activate iRow = exTab.Worksheets(1).UsedRange.SpecialCells(xlCellTypeLastCell).Row iColumn = exTab.Worksheets(1).UsedRange.SpecialCells(xlCellTypeLastCell).Column exTab.Application.CutCopyMode = False exTab.Application.CutCopyMode = False exTab.Application.CutCopyMode = False exTab.Range(Cells(1, 1), Cells(iRow, iColumn)).Select exTab.Range(Cells(1, 1), Cells(iRow, iColumn)).Copy 'Textmarker 'Seitenumbruch 'Set einfuegeBereich = ActiveDocument.Range(ActiveDocument.Range.End - 1, ActiveDocument.Range.End) 'einfuegeBereich.Paste ActiveDocument.Activate Selection.Paste Set WordTable = ActiveDocument.Tables(ActiveDocument.Tables.Count) ActiveDocument.Tables(ActiveDocument.Tables.Count).Select With Selection.ParagraphFormat .LeftIndent = CentimetersToPoints(0.2) .RightIndent = CentimetersToPoints(0.2) End With WordTable.AutoFitBehavior (wdAutoFitWindow) exTab.Application.DisplayAlerts = False exTab.Workbooks.Close End Function The error in in the function importFromExcel at line "exTab.Range(Cells(1, 1), Cells(iRow, iColumn)).Select". I would be happy for usefull suggestions. Thanks! |
#2
|
|||
|
|||
Without being able to see what the variables are set as i would think that your starting point would be to set a stop at this row and hover your mouse over the variables to see what they are at this point - irow, icolumn & extab
"exTab.Range(Cells(1, 1), Cells(iRow, iColumn)).Select" Its possible that there is nothing in the used range when assigning the variable here or the workbook references isnt open iRow = exTab.Worksheets(1).UsedRange.SpecialCells(xlCellT ypeLastCell).Row iColumn = exTab.Worksheets(1).UsedRange.SpecialCells(xlCellT ypeLastCell).Column If you know to do it you can set watches on these variables as well as the stop which makes it easier to debug. |
#3
|
|||
|
|||
At first, thanks for the suggestion. I solved the Problem, which im working on 2 days now.
I removed the error handler and saw, that the Cells-Method wasn't able to be executed. I had to add the activesheet-object, so it can adress the right sheet, because the code opens a workbook and closees it in each round. Thank you very much, because in other forums nobody even responsed. |
#4
|
||||
|
||||
See:
• Send Mailmerge Output to Individual Files; • Run a Mailmerge from Excel, Sending the Output to Individual Files; and • Split Merged Output to Separate Documents, in the Mailmerge Tips and Tricks 'Sticky' thread at the top of the mailmerge forum: https://www.msofficeforums.com/mail-...ps-tricks.html
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
Tags |
attach table, mail merge code, vba |
|
Similar Threads | ||||
Thread | Thread Starter | Forum | Replies | Last Post |
Mail Merge Attachment and Standard body of the mail | abdulads@yahoo.com | Mail Merge | 1 | 05-17-2018 07:47 PM |
Compatibility of 2 macros in mail merge: Delete table rows + save individual PDFs | Btop | Word VBA | 26 | 03-07-2018 01:45 PM |
How To Do Mail Merge and add an attachment eg PDF | JohnyBoy | Mail Merge | 2 | 08-25-2015 08:53 PM |
Mail merge with attachment | vijanand1279 | Word | 3 | 11-22-2011 12:52 PM |
email as pdf attachment - subject line and attachment named after mail merge | Nexus | Mail Merge | 12 | 04-13-2011 11:34 PM |