Microsoft Office Forums

Go Back   Microsoft Office Forums > >

Reply
 
Thread Tools Display Modes
  #1  
Old 11-09-2020, 04:11 AM
WaterIT WaterIT is offline Save automatic Mail Merge with excel table as attachment Windows 10 Save automatic Mail Merge with excel table as attachment Office 2019
Novice
Save automatic Mail Merge with excel table as attachment
 
Join Date: Nov 2020
Posts: 2
WaterIT is on a distinguished road
Default 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
This Code is working in the first round perfectly. In the second round (second bill), he throws an error by selecting a range from the excel-table. In the first round as i said, it works fine.
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!
Reply With Quote
  #2  
Old 11-09-2020, 04:58 AM
Purfleet Purfleet is offline Save automatic Mail Merge with excel table as attachment Windows 10 Save automatic Mail Merge with excel table as attachment Office 2019
Expert
 
Join Date: Jun 2020
Location: Essex
Posts: 345
Purfleet is a splendid one to beholdPurfleet is a splendid one to beholdPurfleet is a splendid one to beholdPurfleet is a splendid one to beholdPurfleet is a splendid one to beholdPurfleet is a splendid one to beholdPurfleet is a splendid one to behold
Default

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.
Reply With Quote
  #3  
Old 11-09-2020, 05:07 AM
WaterIT WaterIT is offline Save automatic Mail Merge with excel table as attachment Windows 10 Save automatic Mail Merge with excel table as attachment Office 2019
Novice
Save automatic Mail Merge with excel table as attachment
 
Join Date: Nov 2020
Posts: 2
WaterIT is on a distinguished road
Default

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.
Reply With Quote
  #4  
Old 11-09-2020, 01:07 PM
macropod's Avatar
macropod macropod is offline Save automatic Mail Merge with excel table as attachment Windows 10 Save automatic Mail Merge with excel table as attachment Office 2010
Administrator
 
Join Date: Dec 2010
Location: Canberra, Australia
Posts: 21,956
macropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond repute
Default

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]
Reply With Quote
Reply

Tags
attach table, mail merge code, vba

Thread Tools
Display Modes


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
Save automatic Mail Merge with excel table as attachment Compatibility of 2 macros in mail merge: Delete table rows + save individual PDFs Btop Word VBA 26 03-07-2018 01:45 PM
Save automatic Mail Merge with excel table as attachment 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
Save automatic Mail Merge with excel table as attachment email as pdf attachment - subject line and attachment named after mail merge Nexus Mail Merge 12 04-13-2011 11:34 PM

Other Forums: Access Forums

All times are GMT -7. The time now is 07:49 AM.


Powered by vBulletin® Version 3.8.11
Copyright ©2000 - 2024, vBulletin Solutions Inc.
Search Engine Optimisation provided by DragonByte SEO (Lite) - vBulletin Mods & Addons Copyright © 2024 DragonByte Technologies Ltd.
MSOfficeForums.com is not affiliated with Microsoft