79484036

Date: 2025-03-04 14:53:49
Score: 1.5
Natty:
Report link

I found a solution to my problem. The connection string and SQLstatement were wrong. I also added the functionality I wanted to open word, perform the mail merge and convert to pdf using the first name and last name from my database. I will post code below for anyone interested. Thanks to all who responded. Appreciate the help. Cheers.

Public Sub MailMergeRun(FilePath As String, WorkbookPath As String, SQLstring As String, SelRow As Long)
    Dim wdapp As Object
    Dim mydoc As Object
    Dim connectionString As String
    Dim firstName As String
    Dim lastName As String
    Dim folderPath As String
    Dim pdfFilePath As String
    Dim folderName As String
    Dim xlSheet As Worksheet
    Dim firstNameCell As Range
    Dim lastNameCell As Range
    
    ' Access the Main Database sheet in the current workbook
    Set xlSheet = ThisWorkbook.Sheets("Main Database")
    
    ' Get the person's first and last name from the Main Database sheet (based on SelRow)
    Set firstNameCell = xlSheet.Cells(SelRow, 3)  ' Assuming FirstName is in Column C
    Set lastNameCell = xlSheet.Cells(SelRow, 4)   ' Assuming LastName is in Column D
    
    firstName = firstNameCell.Value
    lastName = lastNameCell.Value

    ' Create the folder path using the person's name
    folderName = firstName & " " & lastName
    folderPath = "C:\Documents C\Mail Merge Conscious Clay\Conscious Clay Mail Merge Forms\Populated PDFs\" & folderName  ' Change this base path as needed
    
    ' Check if the folder exists, and create it if not
    If Dir(folderPath, vbDirectory) = "" Then
        MkDir folderPath
    End If
    
    ' Build the file path for saving the PDF
    pdfFilePath = folderPath & "\" & firstName & "_" & lastName & "_" & Replace(Mid(FilePath, InStrRev(FilePath, "\") + 1), ".docx", ".pdf")
    
    ' Initialize Word application (Check if it's running, otherwise create a new one)
    On Error Resume Next
    Set wdapp = GetObject(, "Word.Application")
    On Error GoTo 0
    
    If wdapp Is Nothing Then
        Set wdapp = CreateObject("Word.Application")
    End If
    
    ' Make Word invisible for processing
    wdapp.Visible = False
    
    ' Open the Word document for mail merge
    Set mydoc = wdapp.Documents.Open(FilePath, False, False, False)
    wdapp.ActiveDocument.MailMerge.MainDocumentType = wdFormLetters
    
    ' Connection string for Excel workbook (adjust path as necessary)
    connectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & WorkbookPath & ";Extended Properties=""Excel 12.0 Xml;HDR=YES;IMEX=1"""
    
    ' Open the data source (Excel file) and execute the mail merge
    wdapp.ActiveDocument.MailMerge.OpenDataSource _
        Name:=WorkbookPath, _
        Format:=wdOpenFormatAuto, _
        ConfirmConversions:=False, _
        ReadOnly:=False, _
        LinkToSource:=False, _
        AddToRecentFiles:=False, _
        PasswordDocument:="", _
        PasswordTemplate:="", _
        Revert:=False, _
        WritePasswordDocument:="", _
        WritePassWordTemplate:="", _
        Connection:=connectionString, _
        SQLStatement:="SELECT * FROM [Main Database$]", _
        SubType:=wdMergeSubTypeOther
    
    ' Perform the mail merge
    With wdapp.ActiveDocument.MailMerge
        .Destination = wdSendToNewDocument
        .SuppressBlankLines = True
        .DataSource.FirstRecord = SelRow - 1  ' Ensure the first record is adjusted correctly
        .DataSource.LastRecord = SelRow - 1   ' Ensure the last record is adjusted correctly
        .Execute Pause:=False
    End With
    
    ' Save the new document as a PDF (the merged result)
    wdapp.ActiveDocument.SaveAs2 pdfFilePath, 17  ' 17 = wdFormatPDF
    
    ' Close the new merged document without saving changes (this prevents saving changes to Word doc)
    wdapp.ActiveDocument.Close SaveChanges:=False
    
    ' Quit Word without saving any changes to the original document
    wdapp.Quit SaveChanges:=False
    
    ' Release objects
    Set wdapp = Nothing
    Set mydoc = Nothing
    Set xlSheet = Nothing

    MsgBox "Mail merge complete and saved as PDF in: " & pdfFilePath
End Sub
Reasons:
  • Blacklisted phrase (0.5): Thanks
  • Blacklisted phrase (1): Cheers
  • Long answer (-1):
  • Has code block (-0.5):
  • Self-answer (0.5):
  • Low reputation (1):
Posted by: Frank Bangham