Mail Merge Query - Please help

[ChrisMac]

Hi, I have the following piece of code that I would like to enhance the SQL statement to invoke mail merge only if count of LtrTemp is greater than Zero (0). Please help

SQL1 = "SELECT * FROM `Imported Data$`"
SQL2 = " WHERE (`Imported Data$`.Letter_Code='" & LtrTemp & "')"


ActiveDocument.MailMerge.OpenDataSource Name:=offerdatafile, _
ConfirmConversions:=False, ReadOnly:=False, LinkToSource:=True, _
AddToRecentFiles:=False, PasswordDocument:="", PasswordTemplate:="", _
WritePasswordDocument:="", WritePasswordTemplate:="", Revert:=False, _
Format:=wdOpenFormatAuto, Connection:=strConnection _
, SQLStatement:=SQL1, SQLStatement1:=SQL2, SubType:= _
wdMergeSubTypeOther

[Tinbendr]

[vba]
If LtrTemp > 0 Then
SQL1 = "SELECT * FROM `Imported Data$`"
SQL2 = " WHERE (`Imported Data$`.Letter_Code='" & LtrTemp & "')"


ActiveDocument.MailMerge.OpenDataSource Name:=offerdatafile, _
ConfirmConversions:=False, ReadOnly:=False, LinkToSource:=True, _
AddToRecentFiles:=False, PasswordDocument:="", PasswordTemplate:="", _
WritePasswordDocument:="", WritePasswordTemplate:="", Revert:=False, _
Format:=wdOpenFormatAuto, Connection:=strConnection _
, SQLStatement:=SQL1, SQLStatement1:=SQL2, SubType:= _
wdMergeSubTypeOther
End If[/vba]

[ChrisMac]

Tinbendr, Thank you.

Tried your advice but it did not work.

Attached find the files, that way you may be in a position to test it your self.

Open the Letter processing file after unzipping the file, the code below is found in Private Sub cmdPrintLetters_Click()


Regards,
Chrisphine Mwangi

[Tinbendr]

You're going to have to explain WHAT you are counting.

I see that LtrTemp is actually a string, but it doesn't advance in number anywhere in that loop.

Could you mean 'x'?

[VBA]For x = 0 To UBound(FinalText) - 1
LtrTemp = Mid(FinalText(x), 1, 6)[/VBA]

If you are looking whether LtrTemp is empty, then

[VBA]if LtrTemp <> "" then[/VBA]

[ChrisMac]

For x = 0 To UBound(FinalText) - 1

Above code is used to open templates in the Templates folder. The 1st 6 characters of the template happens to be be a Letter Code in the spreadsheet used for mail merge.

However, Not all templates will have a record in the spreadsheet. I would like the tool to skip mailmerge for templates that do not have a record in
the spreadsheet.

Hope that explains

[Tinbendr]

I think what I would do is when the array is created, run another sub to check the record count. If Count 0, then just don't add it to the array.

I'm having trouble following the code, so if you need more specific help, you'll have to write a program flow outline for me.

[ChrisMac]

Hi, tried to explain each line of code, See if you can help me out.

I appreciate all the support.

Private Sub cmdPrintLetters_Click()
Dim x As Integer
Dim LtrTemp As String
Dim oXL As Object

1. Initialise the variables to collect current path/folder informartion to be
used later for data and query path definition.

Initialise_Path

2. Loop through documnets in template folder and save file name in array named FinalText

For x = 0 To UBound(FinalText) - 1

3. Get 1st 6 characters of file names saved in array and assign to LtrTemp variable

LtrTemp = Mid(FinalText(x), 1, 6)

4. Open the 1st Template Document

Documents.Open FileName:=TemplatesDir & LtrTemp & ".doc", AddToRecentFiles:=False, _
Revert:=False, Format:=wdOpenFormatAuto ', Encoding:=msoEncodingAutoDetect ', Visible:=1

5. Declare private variables to hold sql statement

Dim SQL1, SQL2, strConnection

6. Initialise the variables to collect current path/folder information to be
used later for data and query path definition.

CurrentDir = ActiveDocument.Path

7. Length of the string with only the path infor. less current folder name

StrLength = (Len(CurrentDir) - 9)

8. Current path without current folder name

OfferDir = Left(CurrentDir, StrLength)

9. Location of query file relative to current path

OfferQueryFile = OfferDir & "Query\DECLINEAll.dqy"

10. Location of Data file relative to current path. May be important later.

offerdatafile = OfferDir & "Data\Letters Solution.xls"
OfferDataDir = OfferDir & "Data"
TemplateName = ActiveDocument.Name

11. Document is password protected so I unprotect first

UnProtectDoc

12. Collect the current DataSource name to enable testing.

DataScName = ActiveDocument.MailMerge.DataSource.Name

13. Test and see if the datasource name is still active and if so blank it to
enable re-initialisation with the current folder data

If DataScName <> "" Then
ActiveDocument.MailMerge.DataSource.Close
End If

14. Re-establish the mailmerge source.

strConnection = "DSN=Excel Files;" _
& "DBQ=" & offerdatafile & ";DriverId=790;" _
& "MaxBufferSize=2048;PageTimeout=5;"

15. Create sql statement to retrieve data to be used in mailmerge. This is where I want to take care of templates (LtrTemp) that do not have a matching code in the data source. If count of LTrTemp in data source is Zero then close template opened in 4 above.

SQL1 = "SELECT * FROM `Imported Data$`"
SQL2 = " WHERE (`Imported Data$`.Letter_Code='" & LtrTemp & "')"

16. Start mailmerge

ActiveDocument.MailMerge.OpenDataSource Name:=offerdatafile, _
ConfirmConversions:=False, ReadOnly:=False, LinkToSource:=True, _
AddToRecentFiles:=False, PasswordDocument:="", PasswordTemplate:="", _
WritePasswordDocument:="", WritePasswordTemplate:="", Revert:=False, _
Format:=wdOpenFormatAuto, Connection:=strConnection _
, SQLStatement:=SQL1, SQLStatement1:=SQL2, SubType:= _
wdMergeSubTypeOther
ActiveDocument.MailMerge.ViewMailMergeFieldCodes = False
Merge_Document

17. Go to the next template
Next x

18. Once all templates have been taken care off, protect the document.

ProtectDoc

End Sub

[Tinbendr]

Sorry, I should have been more specific. This sub I understand, but I don't think trying to intercept the mailmerge is the best place to check for the template.

After the LtrTemp is set, you could use a sub to go out and check the spreadsheet to see if Count is greater than 0. Am I right? Is the Count on the spreadsheet what we're looking for? If LtrTemp Count is greater than 0 then mailmerge?

[ChrisMac]

Yes you are right, I am looking for the count in the spreadsheet.

I have been knocking my head trying to write code for doing that count but I cannot.

It is easy said than done, Can you help?

[Tinbendr]

OK, try this. I added a if-then-boolean function to test for the count. (Look at the end of ThisDocument)

[ChrisMac]

Hi,

Thank you for the input. I took your advice and explored other options and was finally able to pass LtrTemp to Excel as a variable and that way I can loop through th evarious templates and in so doing check if record count is greater than Zero.

I run a function ExcelResponce in word that calls Macro3 in excel

[VBA]
Function ExcelResponce()
Initialise_Path
Dim oXL As Object
Dim wbBook As Object
Dim sstr As String
Dim lt As String
Dim ActiveDoc As String
Set oXL = CreateObject("Excel.Application")
On Error Resume Next
Set wbBook = oXL.Workbooks(sFileName)
On Error GoTo 0
lt = "LTRCH7"
ActiveDoc = ActiveDocument.Path & "\" & ActiveDocument.Name
If wbBook Is Nothing Then
Set wbBook = oXL.Workbooks.Open(CurrDir & "\Data" & "\Letters Solution2.xls", , False)
oXL.Run "'" & "Letters Solution2.xls" & "'" & "!" & "Macro3", lt, ActiveDoc
End If
wbBook.Close
End Function
[/VBA]

Macro 3 will count occurences of Ltr with is updated in countNonBlank

[VBA]
Function Macro3(LtrT As String, ActiveDoc As String)
Dim countNonBlank As Integer, myRange As Range
Dim X As Object
Initialise_Path
Set myRange = Columns("A:A")
countNonBlank = Application.WorksheetFunction.CountIf(myRange, LtrT)
Call button1_click(countNonBlank, ActiveDoc)
End Function
[/VBA]

My challenge is in passing value in countNonBlank back to word for decision making on whether to proceeed with mail merge or not.

See the code I have and advise if you can improve on it.

[VBA]Sub button1_click(Ltrs As Integer, ActiveDoc As String)
Dim wrdApp As Word.Application
Dim wrdDoc As Word.Document
Dim sstr As String
Dim wdApp As Word.Application
Set WordApp = GetObject(, "Word.Application")
Set wrdDoc = GetObject(CurrDir & "\" & ActiveDoc)
WordApp.Run "'" & ActiveDoc & "'" & "!" & "WordMacro", Ltrs
End Sub[/VBA]

I have attached the xls & word file. Button2 triggers the above code into action

Regards,