Word Mail Merge and Name File (VBA Code Error)

**wealthistime** · 03-30-2011, 09:56 AM

Hey guys (and gals),

I'm really frustrated, I had this working, lost my code, and now I can't figure out where I going wrong trying to get it working again. The code below opens Microsoft Word, uses mail merge, then outputs the Word Doc in PDF, and it names that PDF and saves it to a specified location...

The first time I run the Macro it works perfectly, but the second time I run it it either crashes or Excel freezes on me. If it crashes and I hit debug, and then run the macro again without changing anything- it works perfectly. I'm really stumped here and frustrated.

When I step through it...every time the mail merge runs it is creating a new document (IE "Letter1") and each subsequent run of the macro creates Letter2, Letter3, etc. I don't know why it's doing this. Originally the way it worked it just used the source Doc for mail merge without creating a new document...but I can't seem to get it working again.

Lastly...as you can see in my IF Len(Dir function...if the file exists it creates another file with "-2" on the end of the file name. I would like to make it such that it continues this...(either up to -10 or infitinitely if possible) but my skills are limited so I just have "-1" and "-2". Thank you all for your time!

Sub Merge()

    Dim wd As Object
    Dim wdocSource As Object
    Dim strWorkbookName As String

    On Error Resume Next
    Set wd = GetObject(, "Word.Application")
    If wd Is Nothing Then
        Set wd = CreateObject("Word.Application")
    End If
    On Error GoTo 0

    Set wdocSource = wd.Documents.Open("C:\Documents and Settings\christopher.kline\Desktop\Work Files\Projects\Pending\Automated Bank Memo\AIB Bank Memo.doc")

    strWorkbookName = ThisWorkbook.Path & "\" & ThisWorkbook.Name
    wdocSource.MailMerge.MainDocumentType = wdFormLetters

    wdocSource.MailMerge.OpenDataSource _
        Name:=strWorkbookName, _
        AddToRecentFiles:=False, _
        Revert:=False, _
        Format:=wdOpenFormatAuto, _
        Connection:="Data Source=" & strWorkbookName & ";Mode=Read", _
        SQLStatement:="SELECT * FROM `Data$`"

    With wdocSource.MailMerge
        .Destination = wdSendToNewDocument
        .SuppressBlankLines = True
        
        With .DataSource
        .FirstRecord = wdDefaultFirstRecord
        .LastRecord = wdDefaultLastRecord
        End With
        
        .Execute Pause:=False
    End With

    wdocSource.Close SaveChanges:=True
    wd.Visible = False

    Set wdocSource = Nothing
    Set wd = Nothing

    If Len(Dir("P:\LNL Finance 2008\BANK MEMOS\Created and Sent" & "\" & "BankTEST- " & Format(Date, "mm-dd-yy") & "-1.pdf")) Then
        ActiveDocument.ExportAsFixedFormat OutputFileName:="P:\LNL Finance 2008\BANK MEMOS\Created and Sent" & "\" & "BankTEST- " & Format(Date, "mm-dd-yy") & "-2.pdf", ExportFormat:= _
        wdExportFormatPDF, OpenAfterExport:=False, OptimizeFor:= _
        wdExportOptimizeForPrint, Range:=wdExportAllDocument, _
        Item:=wdExportDocumentContent, IncludeDocProps:=True, KeepIRM:=True, _
        CreateBookmarks:=wdExportCreateNoBookmarks, DocStructureTags:=True, _
        BitmapMissingFonts:=True, UseISO19005_1:=False
    Else
        ActiveDocument.ExportAsFixedFormat OutputFileName:="P:\LNL Finance 2008\BANK MEMOS\Created and Sent" & "\" & "BankTEST- " & Format(Date, "mm-dd-yy") & "-1.pdf", ExportFormat:= _
        wdExportFormatPDF, OpenAfterExport:=False, OptimizeFor:= _
        wdExportOptimizeForPrint, Range:=wdExportAllDocument, _
        Item:=wdExportDocumentContent, IncludeDocProps:=True, KeepIRM:=True, _
        CreateBookmarks:=wdExportCreateNoBookmarks, DocStructureTags:=True, _
        BitmapMissingFonts:=True, UseISO19005_1:=False
    End If

    ActiveDocument.Close (False)
    Word.Application.Quit

End Sub

**wealthistime** · 03-30-2011, 10:04 AM

When I run the Macro a second time, sometimes I get "Run Time Error 462 The remote server machine does not exist or is unavialable." But when i click end and run it a third time, the bloody thing works! And yet, it seems like if i run this macro a bunch of time in a row, then instead of this error Excel just freezes up on me.

**snb** · 03-30-2011, 11:06 AM

check the indexnumber of wdExportFormatPDF.
Where in the code you have to put this indexnumber I have marked with ****

Using getobject or createobject you can't submit wdarguments; you have to pass their indexnumber.
You can reduce the code to:

Sub pdf_snb()
  with GetObject("C:\Documents and Settings\christopher.kline\Desktop\Work Files\Projects\Pending\Automated Bank Memo\AIB Bank Memo.doc")
   with .mailmerge
     .MainDocumentType = wdFormLetters
     .OpenDataSource thisworkbook.fullname, , , , , , , , , , , "Data Source=" & thisworkbook.fullname & ";Mode=Read","SELECT * FROM `Data$`")
     .Destination = wdSendToNewDocument
     .SuppressBlankLines = True
     .Execute False
    End With
     
    c00="P:\LNL Finance 2008\BANK MEMOS\Created and Sent" & "\" & "BankTEST- " & Format(Date, "mm-dd-yy") 
    .application.Documents(1).ExportAsFixedFormat c00 & iif(dir(c00 &  "-1.pdf")="", "-2","-1) & ".pdf",****
    .Close 0
  end with
End Sub

**wealthistime** · 03-31-2011, 11:43 AM

Hi SNB,

Thanks so much for your help. Unfortunately, I don't know what an index number is or what you meant. I tried to google it and figure it out to no avail. Could you help me understand what I need to insert in place of the ****? I'm very new to VBA. Also...should iif(dir be if(dir? Thanks again for your time. I'm really impressed with how much cleaner your code is that what i put together!

**snb** · 03-31-2011, 12:24 PM

I filled in the ***
the iif is correct.

Sub pdf_snb()
  with GetObject("C:\Documents and Settings\christopher.kline\Desktop\Work Files\Projects\Pending\Automated Bank Memo\AIB Bank Memo.doc")
   with .mailmerge
     .MainDocumentType = wdFormLetters
     .OpenDataSource thisworkbook.fullname, , , , , , , , , , , "Data Source=" & thisworkbook.fullname & ";Mode=Read","SELECT * FROM `Data$`")
     .Destination = wdSendToNewDocument
     .SuppressBlankLines = True
     .Execute False
    End With
     
    c00="P:\LNL Finance 2008\BANK MEMOS\Created and Sent" & "\" & "BankTEST- " & Format(Date, "mm-dd-yy") 
    .application.Documents(1).ExportAsFixedFormat c00 & iif(dir(c00 &  "-1.pdf")="", "-2","-1) & ".pdf",17
    .Close 0
  end with
End Sub

**wealthistime** · 04-01-2011, 12:27 AM

I must be doing something wrong here- when I copy and paste in the code I get two syntax errors (VBA higlights the row in red):

1) .OpenDataSource There is an end paranthesis at the end of the line, and when I remove it VBA says the line is good

2) .application.Documents(1) VBA gives me a syntax error for this line. It highlights the period in &".pdf,17" and says "Compile Error, Expected: List Separator or )

When I was googling the index number last night I did see that it was 17 for a PDFexport...but I just figured I had it wrong. Any ideas? Attached is a screenshot...

Below is the exact code I'm using in module2 after removing the end paranthesis:

Sub pdf_snb()
  With GetObject("C:\Documents and Settings\christopher.kline\Desktop\Work Files\Projects\Pending\Automated Bank Memo\AIB Bank Memo.doc")
   With .MailMerge
     .MainDocumentType = wdFormLetters
     .OpenDataSource ThisWorkbook.FullName, , , , , , , , , , , "Data Source=" & ThisWorkbook.FullName & ";Mode=Read", "SELECT * FROM `Data$`"
     .Destination = wdSendToNewDocument
     .SuppressBlankLines = True
     .Execute False
    End With
     
    c00 = "P:\LNL Finance 2008\BANK MEMOS\Created and Sent" & "\" & "BankTEST- " & Format(Date, "mm-dd-yy")
    .application.Documents(1).ExportAsFixedFormat c00 & iif(dir(c00 &  "-1.pdf")="", "-2","-1) & ".pdf",17
    .Close 0
  End With
End Sub

**snb** · 04-01-2011, 08:58 AM

in your screenshot it highlights the comma.
You should use a dot instead.

**wealthistime** · 04-01-2011, 09:08 AM

I'm sorry but I'm not following you. In the screenshot, the period is hilighted. The period in the & ".pdf" , 17 is highlighted...

**snb** · 04-01-2011, 09:20 AM

copy this:

.application.Documents(1).ExportAsFixedFormat c00 & iif(dir(c00 &  "-1.pdf")=", "-2","-1) & ".pdf",17

**wealthistime** · 04-02-2011, 02:38 AM

It still gave me a syntax error but by removing the .pdf from the iif statement it worked perfectly! Thank you! Code is below. Two more questions:

When the code runs, a promp comes up asking me if I want to use the data source (SELECT * FROM `Data$). How can I disable this so it automatically hits yes? Also, in my old code Word was not visible. How can I make it so that when you run the Macro the user never sees word open or close?

Sub pdf_snb()
  With GetObject("C:\Documents and Settings\christopher.kline\Desktop\Work Files\Projects\Pending\Automated Bank Memo\AIB Bank Memo.doc")
   With .MailMerge
     .MainDocumentType = wdFormLetters
     .OpenDataSource ThisWorkbook.FullName, , , , , , , , , , , "Data Source=" & ThisWorkbook.FullName & ";Mode=Read", "SELECT * FROM `Data$`"
     .Destination = wdSendToNewDocument
     .SuppressBlankLines = True
     .Execute False
    End With
         
    c00 = "P:\LNL Finance 2008\BANK MEMOS\Created and Sent" & "\" & "BankTEST- " & Format(Date, "mm-dd-yy")
    .Application.Documents(1).ExportAsFixedFormat c00 & IIf(Dir(c00 & "-1.pdf") = "", "-1", "-2"), 17
    .Close 0
  End With

End Sub

**wealthistime** · 04-14-2011, 03:47 AM

Instead of trying to name each file -1, -2, -3 etc I just appended the time in HHMMSS to the filename, thereby differentiating each file. I also made it such that my master file "resets" itself after the code is run, and set the closeworkbook property to disable saveas (not shown below). The final code is below:

Sub MergePDF()
' This macro mail merges the data for Bank Memos and prints to PDF to a designated folder (IE the desktop).

' This speeds up the macro.
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.DisplayAlerts = False

' This ensures calculation is set to automatic.
Application.Calculation = xlCalculationAutomatic

' This deletes all the rows where Column D (Taskera#) is blank.
Dim myColm As Range
Set myColm = Columns("D:D")
On Error Resume Next
myColm.SpecialCells(xlCellTypeBlanks).EntireRow.Delete

' This does a mail merge with the Bank Memo word Document. Be sure to change the file path accordingly.
With GetObject("C:\Documents and Settings\christopher.kline\Desktop\AIB Bank Memo.doc")
With .MailMerge
.MainDocumentType = wdFormLetters
.OpenDataSource ThisWorkbook.FullName, , , , , , , , , , , "Data Source=" & ThisWorkbook.FullName & ";Mode=Read", "SELECT * FROM `Data$`"
.Destination = wdSendToNewDocument
.SuppressBlankLines = True
.Execute False
End With

' This prints the Bank Memo to PDF and saves it to a designated folder (IE the desktop). Be sure to change the file path accordingly.
c00 = "C:\Documents and Settings\christopher.kline\Desktop" & "\" & "Bank Memo- " & Format(Date, "mm-dd-") & Format(Time, "hhmmss") & ".pdf"
.Application.Documents(1).ExportAsFixedFormat c00, 17
.Close 0
End With

' This puts formulas in row 2 and copies it down.
Range("A2").Select
Selection.ClearContents
Range("B2").Select
ActiveCell.FormulaR1C1 = _
"=VLOOKUP(CONCATENATE(""AFG-"",RC1),'F:\LNL Finance 2008\BANK MEMOS\[AIB Account Records.xlsm]Active'!R1C3:R60000C7,2,FALSE)"
Range("C2").Select
ActiveCell.FormulaR1C1 = _
"=VLOOKUP(CONCATENATE(""AFG-"",RC1),'F:\LNL Finance 2008\BANK MEMOS\[AIB Account Records.xlsm]Active'!R1C3:R60000C7,3,FALSE)"
Range("D2").Select
Selection.ClearContents
Range("E2").Select
ActiveCell.FormulaR1C1 = "=CONCATENATE(RC[-3],"" "",RC[-2])"
Range("F2").Select
ActiveCell.FormulaR1C1 = "=NOW()"
Range("A2:F2").Select
Selection.AutoFill Destination:=Range("A2:F16"), Type:=xlFillDefault

' This applies formatting to the table.
Range("A2:F16").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
Range("A1:A16,D1:D16,A1:F1").Select
Range("F1").Activate
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
Range("D2:D16,A2:A16").Select
Range("A16").Activate
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent6
.TintAndShade = 0.799981688894314
.PatternTintAndShade = 0
End With
Range("A2").Select

End Sub