Excel vba mail merge first and last record not working - Stack Overflow

admin2025-04-19  0

I am creating a spreadsheet to automate mail merge from a selected line in a listbox.

My function opens the word document ok but the first and last record section is not working and the mail merge document is always opened on the second line of the database.

Anyone able to help me identify what is going wrong? I have used the values of 3 and 5 for first and last record but will be using a variable later.

Cheers.

Public Sub MailMergeRun(FilePath As String, WorkbookPath As String, _
                                  SQLstring As String, SelRow As Long)
    Dim wdapp As Word.Application
    Dim mydoc As Word.Document
    
    
    On Error Resume Next
    Set wdapp = GetObject(, "Word.Application")
    
    If Err.Number <> 0 Then
        Set wdapp = CreateObject("Word.Application")
    End If
    ' On Error GoTo ErrorHandler
    
    With wdapp
            ' On Error GoTo ErrorHandler
            .Visible = True
        
        ' Open form file and associate data file
            Set mydoc = .Documents.Open(FilePath, False, False, False)
            .ActiveDocument.MailMerge.MainDocumentType = wdFormLetters
            .ActiveDocument.MailMerge.OpenDataSource Name:=WorkbookPath, _
            ConfirmConversions:=False, ReadOnly:=False, LinkToSource:=False, _
            AddToRecentFiles:=False, PasswordDocument:="", PasswordTemplate:="", _
            WritePasswordDocument:="", WritePassWordTemplate:="", Revert:=False, _
            Format:=wdOpenFormatAuto, Connection:="", _
            SQLStatement:=SQLstring, SQLStatement1:="", _
            SubType:=wdMergeSubTypeOther

            ' Merge to a new document
        With wdapp.ActiveDocument.MailMerge
            .Destination = wdSendToNewDocument
            .SuppressBlankLines = True
            .DataSource.FirstRecord = 3
            .DataSource.LastRecord = 5
            .Destination = wdSendToNewDocument
            .Execute Pause:=False
        End With
        
    End With
        
End Sub

I am creating a spreadsheet to automate mail merge from a selected line in a listbox.

My function opens the word document ok but the first and last record section is not working and the mail merge document is always opened on the second line of the database.

Anyone able to help me identify what is going wrong? I have used the values of 3 and 5 for first and last record but will be using a variable later.

Cheers.

Public Sub MailMergeRun(FilePath As String, WorkbookPath As String, _
                                  SQLstring As String, SelRow As Long)
    Dim wdapp As Word.Application
    Dim mydoc As Word.Document
    
    
    On Error Resume Next
    Set wdapp = GetObject(, "Word.Application")
    
    If Err.Number <> 0 Then
        Set wdapp = CreateObject("Word.Application")
    End If
    ' On Error GoTo ErrorHandler
    
    With wdapp
            ' On Error GoTo ErrorHandler
            .Visible = True
        
        ' Open form file and associate data file
            Set mydoc = .Documents.Open(FilePath, False, False, False)
            .ActiveDocument.MailMerge.MainDocumentType = wdFormLetters
            .ActiveDocument.MailMerge.OpenDataSource Name:=WorkbookPath, _
            ConfirmConversions:=False, ReadOnly:=False, LinkToSource:=False, _
            AddToRecentFiles:=False, PasswordDocument:="", PasswordTemplate:="", _
            WritePasswordDocument:="", WritePassWordTemplate:="", Revert:=False, _
            Format:=wdOpenFormatAuto, Connection:="", _
            SQLStatement:=SQLstring, SQLStatement1:="", _
            SubType:=wdMergeSubTypeOther

            ' Merge to a new document
        With wdapp.ActiveDocument.MailMerge
            .Destination = wdSendToNewDocument
            .SuppressBlankLines = True
            .DataSource.FirstRecord = 3
            .DataSource.LastRecord = 5
            .Destination = wdSendToNewDocument
            .Execute Pause:=False
        End With
        
    End With
        
End Sub
Share Improve this question asked Mar 3 at 18:20 Frank BanghamFrank Bangham 111 silver badge3 bronze badges 9
  • 2 Always fun having to repost your comments from Staging Ground.... On Error Resume Next hides any issues with your code, so try removing that and re-running. You've also specified FirstRecord and LastRecord - is there a reason for that? What argument is being passed to the SQLString parameter, and what is the purpose of the SelRow parameter? FYI once you have that reference mydoc you should use that in place of ActiveDocument in the code below. – Tim Williams Commented Mar 3 at 18:28
  • Does the SQL have a Order By – CDP1802 Commented Mar 3 at 19:34
  • The SQL im passing it is the header rows and the range of cells as follows: – Frank Bangham Commented Mar 4 at 1:24
  • The SQL im passing it is a string of header rows and the data in the following format. I have had to shorten it as its quite long. SELECT [ID], [Title], [First Name], [Last name], [Reference No.], [Phone], [Email], [Street Address], [Suburb], [State], [Postcode], [Date Ordered], FROM [shMainDatabase$A1:$CJ$6] There is no Order By in the SQL. Correct that I am not using SelRow here as that will be the row that I want to print but was trying to get it working with hard coded values first. – Frank Bangham Commented Mar 4 at 1:32
  • OK I removed the On Error Resume Next and it came up with a runtime error 429 - Active X component cant create object. – Frank Bangham Commented Mar 4 at 1:53
 |  Show 4 more comments

1 Answer 1

Reset to default 1

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
转载请注明原文地址:http://conceptsofalgorithm.com/Algorithm/1745078046a283684.html

最新回复(0)