Creating letters quicker from spreadsheet

[mbbx5va2]

Hi

Suppose A and B denote two different client letters in MS Word and I'm able to create a mailmerge for each using data from 'SIPP worksheet in Excel that I've attached. So now I have 5 letters of type A and 5 letters of type B.

Now I want a macro / formula to go through each row in column C in the 'SIPP' worksheet and execute one of the two mail merges automatically depending on what value is in column C.

I am thinking that I need to put an IF statement in column D for each row. So that if a cell is A then I execute one type of mail merge and if the cell is B then I execute another. But there's the problem of writing the code to extract data from the spreadsheet and putting it into one of the two letters.

NB: In the attachment If you look at the formula in the cells in column D, I need H or P to mean execute one type of mail merge.

Thanks

[Kenneth Hobs]

Something like this might be of use.

'If Word found locked fields shows after a merge, see this workaround:'http://support.microsoft.com/kb/292155 - due to inline text in Autoshape layout.


'Requires Tools > References > Microsoft Word 11.0 Object Library
Sub MergeRun(frmFile As String, datFile As String, _
  SQL As String, _
  Optional bClose As Boolean = False, Optional bPrint As Boolean = False, _
  Optional iNoCopies As Integer = 1)
  
  Dim wdApp As Word.Application
  Dim myDoc As Word.Document
  
  'Tell user what file is missing and exit.
  If Dir(frmFile) = "" Then
    MsgBox "Form file does not exist." & vbLf & frmFile, _
      vbCritical, "Exit - Missing Form File"
  End If
  If Dir(datFile) = "" Then
    MsgBox "Data file does not exist." & vbLf & datFile, _
      vbCritical, "Exit - Missing Data File"
  End If
  If Dir(frmFile) = "" Or Dir(datFile) = "" Then Exit Sub
  
  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
    wdApp.Application.DisplayAlerts = wdAlertsNone
    
    'Open form file and associate data file
    Set myDoc = .Documents.Open(frmFile, False, True, False)
    .ActiveDocument.MailMerge.MainDocumentType = wdFormLetters
    .ActiveDocument.MailMerge.OpenDataSource Name:=datFile, _
      ConfirmConversions:=False, ReadOnly:=False, LinkToSource:=False, _
      AddToRecentFiles:=False, PasswordDocument:="", PasswordTemplate:="", _
      WritePasswordDocument:="", WritePasswordTemplate:="", Revert:=False, _
      Format:=wdOpenFormatAuto, Connection:="", SQLStatement:=SQL, SQLStatement1 _
      :="", SubType:=wdMergeSubTypeOther
    'Merge to a new document
    With wdApp.ActiveDocument.MailMerge
        .Destination = wdSendToNewDocument
        .SuppressBlankLines = True
        With .DataSource
            .FirstRecord = wdDefaultFirstRecord
            .LastRecord = wdDefaultLastRecord
        End With
        .Execute Pause:=False
    End With
    .Visible = True
    
    If bPrint = True Then
      .Application.PrintOut Filename:="", Range:=wdPrintAllDocument, Item:= _
        wdPrintDocumentContent, Copies:=iNoCopies, Pages:="", PageType:=wdPrintAllPages, _
        ManualDuplexPrint:=False, Collate:=True, Background:=True, PrintToFile:= _
        False, PrintZoomColumn:=0, PrintZoomRow:=0, PrintZoomPaperWidth:=0, _
        PrintZoomPaperHeight:=0
    End If
    
    If bClose = True Then
      .ActiveDocument.Close False
      .ActiveDocument.Close False
    End If


    wdApp.Application.DisplayAlerts = wdAlertsAll
  End With
     
errorExit:
    On Error Resume Next
    myDoc.Close False
    Set myDoc = Nothing
    Set wdApp = Nothing
    Exit Sub
 
errorHandler:
    MsgBox "Unexpected error: " & Err.Number & vbLf & Err.Description
    Resume errorExit
End Sub

[mbbx5va2]

Hi thanks for the response. I will have a go at inserting this into the two if statements and get back to you.

[snb]

In the Word mailmerge maindocument you only need the field:

{If {Mergefield "letter type"} = "A" "{mergefield "first name"}  {mergefield "last name"}" "" }

[mbbx5va2]

I can see that frmfile denotes the word document or letter template and datfile denotes the source data however do I not have to specify a file path e.g: C:\Users\User\Desktop\SIPP.xlsm

somewhere within the code for both source data and the letter. It will take me a bit of time to test a few things as I haven't been using VBA recently. The following code seemed to work initially. I inserted the file path to the word document with following fields: «First_name» «Last_name» «Letter_type»

The code I put into the module within the excel source data doc was:

Sub RunMerge()
 
    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:\Users\User\Desktop\Mailmerge word doc template.docx")
 
    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 `Sheet1$`"
 
    With wdocSource.MailMerge
        .Destination = wdSendToNewDocument
        .SuppressBlankLines = True
        With .DataSource
            .FirstRecord = wdDefaultFirstRecord
            .LastRecord = wdDefaultLastRecord
        End With
        .Execute Pause:=False
    End With
 
    wd.Visible = True
    wdocSource.Close SaveChanges:=False
 
    Set wdocSource = Nothing
    Set wd = Nothing
 
End Sub

I may be over complicating things.

[Kenneth Hobs]

You can hard code parts as you need but doing the SQL string, will select the data that you want. The input parameters do require the full drive:\path\filenames.ext for both your form and data files.

I provided example files in: http://www.vbaexpress.com/forum/show...l-To-Open-Word

Sub MergeRun(frmFile As String, datFile As String, _     SQL As String, _ 
    Optional bClose As Boolean = False, Optional bPrint As Boolean = False, _ 
    Optional iNoCopies As Integer = 1)

[mbbx5va2]

You can hard code parts as you need but doing the SQL string, will select the data that you want. The input parameters do require the full drive:\path\filenames.ext for both your form and data files.

I provided example files in: http://www.vbaexpress.com/forum/show...l-To-Open-Word

Sub MergeRun(frmFile As String, datFile As String, _     SQL As String, _ 
    Optional bClose As Boolean = False, Optional bPrint As Boolean = False, _ 
    Optional iNoCopies As Integer = 1)

Thanks I will have a look through those examples.

[snb]

The simplest way is to make the merge maindocument manually.
After that the only thing you'll have to do in Excel:

Sub M_snb()
    with getobject:("G:\OF\mailmerge_maindocument.docx")
      .mailmerge.execute
      .close 0
    end with 
End Sub

[mbbx5va2]

Hi thanks for the suggestion however I was notable to do what is required. I have come up with the following code:

Sub Rectangle1_Click()





Dim i As Long
Dim pol As String


Set Data = Sheets("Sheet1").Range("A1:A5")


pol = Data.Cells(i + 1, 1).Value


For i = 1 To 5


If Cells(i + 1, 3).Value = "A" Then
     
    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:\Users\User\Desktop\SIPP\Mailmerge word doc template.docx")
     
    strWorkbookName = ThisWorkbook.Path & "\" & ThisWorkbook.Name
     
    wdocSource.MailMerge.MainDocumentType = wdFormLetters
    
    'Unsure whether putting the following statement here is okay?
    SaveAsName = Application.DefaultFilePath & "\" & pol & ".docx"
     
    wdocSource.MailMerge.OpenDataSource _
    Name:=strWorkbookName, _
    AddToRecentFiles:=False, _
    Revert:=False, _
    Format:=wdOpenFormatAuto, _
    Connection:="Data Source=" & strWorkbookName & ";Mode=Read", _
    SQLStatement:="SELECT * FROM `Sheet1$`"
     
    With wdocSource.MailMerge
        .Destination = wdSendToNewDocument
        .SuppressBlankLines = True
        With .DataSource
            .FirstRecord = wdDefaultFirstRecord
            .LastRecord = wdDefaultLastRecord
        End With
        .Execute Pause:=False
        
        'Unsure about the positioning of next statement
        .ActiveDocument.SaveAs Filename:=SaveAsName
    
    End With
     
    wd.Visible = True
    wdocSource.Close SaveChanges:=False
     
    Set wdocSource = Nothing
    Set wd = Nothing


'The IF statement end if below corresponds with the first if then construct located the 6th line down from the top.
End If


Next


End Sub

So here, suppose I have open the SIPP worksheet with the code assigned to a macro button and I have a closed word document with all the mail merge fields in then I want to loop through the rows in column C of the SIPP worksheet executing mail merges for every A in column C. Now each part works individually when tested but now that I've put it all together it doesn't work. I get the error message: Compile error Next without for. The end result should be 2 word documents saved with the first name as the file name.

Any assistance with this would be much appreciated.[IMG]file:///C:\Users\User\AppData\Local\Temp\msohtmlclip1\01\clip_image001.gif[/IMG]

[mbbx5va2]

I don't think the SQL part is correct from my code. And I'm not sure how to resolve this.


I have attached the word doc with the fields I'm working with.