PDA

View Full Version : Creating letters quicker from spreadsheet



mbbx5va2
07-07-2014, 11:36 AM
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
07-07-2014, 01:44 PM
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
07-08-2014, 09:16 AM
Hi thanks for the response. I will have a go at inserting this into the two if statements and get back to you.

snb
07-08-2014, 11:31 AM
In the Word mailmerge maindocument you only need the field:



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

mbbx5va2
07-08-2014, 01:00 PM
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
07-08-2014, 01:54 PM
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/showthread.php?39586-Use-Excel-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
07-08-2014, 02:34 PM
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/showthread.php?39586-Use-Excel-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
07-09-2014, 12:30 AM
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
07-12-2014, 04:30 AM
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.file:///C:\Users\User\AppData\Local\Temp\msohtmlclip1\01\clip_image001.gif

mbbx5va2
07-12-2014, 05:29 AM
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.