MailMerge from Excel, data source not setting

[Zack Barresse]

Hello!

I have some code I threw together which is in Excel which takes a workbook, copies data to a new workbook, opens a Word document based on a file in the same location, saves new workbook and document to users desktop, and creates a mail merge between the two. The code executes just fine and without errors, but the document does not seem to be linking to the data source specified. I'm having a hard time with this one and can't spend a whole lot more time with it. :help

I am using Excel and Word 2010.

The process seems simple enough for me, but it's got me stumped.

In the master (original data) file, this is the code I'm using...
Sub MoveDataForMailMerge(Optional Placebo As Variant)

'Check if activesheet is the master data or table of contents name
If ActiveSheet.Name = MasterData.Name Or ActiveSheet.Name = TOC.Name Then
MsgBox "You must select a quarter sheet first (not the Master Data sheet).", vbExclamation, "ERROR!"
Exit Sub
End If

'Make sure this is the action the user wants to take
sPrompt = "Do you want to copy this data to a new workbook for use with Mail Merge?"
msgAsk = MsgBox(sPrompt, vbYesNo + vbDefaultButton2, "APPEND DATA?")
If msgAsk <> vbYes Then Exit Sub

'Set variables
iLastRow = 2
Set WS = ActiveSheet

'Turn off application events
Call TOGGLEEVENTS(False)

'Create a new (blank) workbook for data transfer
Set wbNew = Workbooks.Add(xlWBATWorksheet)
Set wsNew = wbNew.Worksheets(1)

'Add header rows to new workbook
wsNew.Range("A1:I1").Value = Array("Year", "Quarter", "FirstName", "LastName", "Hour", "Minute", "TotalHours", "CBT", "Met Quota")

'Go through first table, add data to new destination workbook as desired
For Each rCell In WS.Range("A5:A" & WS.Cells(WS.Rows.Count, "A").End(xlUp).Row).Cells

'Just in case there's a blank row in the table...
If rCell.Value = "" Then GoTo SkipTable1

'Add data
wsNew.Cells(iLastRow, 1).Value = Split(WS.Name, " ")(1)
wsNew.Cells(iLastRow, 2).Value = Split(WS.Name, " ")(0)
wsNew.Cells(iLastRow, 3).Resize(1, 6).Value = rCell.Resize(1, 6).Value
wsNew.Cells(iLastRow, 9).Value = "Yes"
wsNew.Cells(iLastRow, 7).Value = WorksheetFunction.RoundUp(wsNew.Cells(iLastRow, 7).Value, 2)

iLastRow = iLastRow + 1

SkipTable1:
Next rCell

'Go through second table, add data to new destination workbook as desired
For Each rCell In WS.Range("H5:H" & WS.Cells(WS.Rows.Count, "H").End(xlUp).Row).Cells

'Just in case there's a blank row in the table...
If rCell.Value = "" Then GoTo SkipTable2

'Add data
wsNew.Cells(iLastRow, 1).Value = Split(WS.Name, " ")(1)
wsNew.Cells(iLastRow, 2).Value = Split(WS.Name, " ")(0)
wsNew.Cells(iLastRow, 3).Resize(1, 6).Value = rCell.Resize(1, 6).Value
wsNew.Cells(iLastRow, 9).Value = "No"
wsNew.Cells(iLastRow, 7).Value = WorksheetFunction.RoundUp(wsNew.Cells(iLastRow, 7).Value, 2) '/ 24
iLastRow = iLastRow + 1

SkipTable2:
Next rCell

'Get current users desktop path, set file name to be used
sTemp = "C:\Documents and Settings\" & Environ("USERNAME") & "\Desktop\" & Replace(WS.Name, " ", "") & "forMailMerge.xlsx"

'Check if the file exists there already
If Dir(sTemp, vbNormal) <> "" Then

'If file exists there already, ensure user wants to continue (delete, create and save)
sPrompt = "It appears a file already exists. Delete existing and save over?" & DNL & "Word should not be open."
msgAsk = MsgBox(sPrompt, vbYesNo + vbDefaultButton2, "DONE")
If msgAsk <> vbYes Then

'New file doesn't need to do anything, get rid of it and go to exit
wbNew.Close False
GoTo ExitTheSub

End If

'Continuing (user wants to continue), delete file
Kill sTemp

End If

'Save new workbook in xlsx format, then close it
wbNew.SaveAs sTemp, 51
wbNew.Close

'Open a Word application
On Error Resume Next
Set WordApp = GetObject(, "Word.Application")
If WordApp Is Nothing Then
Set WordApp = CreateObject("Word.Application")
End If

'Set name and path (template file should reside in the SAME FOLDER as master data file)
sName = "Quarterly Training Hours.docx"
sPath = ThisWorkbook.Path

'Ensure ending character is a path separator, if not, add it
If Right(sPath, 1) <> Application.PathSeparator Then sPath = sPath & Application.PathSeparator

'Open a new document based on template
Set WordDoc = WordApp.Documents.Add(sPath & sName)

'Create letter mail merge
WordDoc.MailMerge.MainDocumentType = 0 'wdFormLetters

'Set temporary name for data source
sTemp = sPath & Left(sName, Len(sName) - 4) & "xlsx"

'Link to data source
WordDoc.MailMerge.OpenDataSource Name:=sTemp, LinkToSource:=True, SQLStatement:="SELECT * FROM Sheet1$"

'Set mail merge specifics
WordDoc.MailMerge.Destination = 0 'wdSendToNewDocument
WordDoc.MailMerge.SuppressBlankLines = True
WordDoc.MailMerge.DataSource.FirstRecord = 1 ' wdDefaultFirstRecord
WordDoc.MailMerge.DataSource.LastRecord = -16 'wdDefaultLastRecord

'Execute mail merge
WordDoc.MailMerge.Execute Pause:=False

'Set new temp variable to users desktop, this time for the Word doc
sTemp = "C:\Documents and Settings\" & Environ("USERNAME") & "\Desktop\" & Replace(WS.Name, " ", "") & "forMailMerge.docx"

'Check if file exists, if it does, delete it
If Dir(sTemp, vbNormal) <> "" Then
Kill sTemp
End If


'Save Word document
WordDoc.SaveAs2 (sTemp)

'Ensure original Excel workbook is the active file
WB.Parent.Activate

'Turn Excel properties back on
Call TOGGLEEVENTS(True)

'Signal user all is well
MsgBox "Process completed successfully!", vbExclamation, "COMPLETE!"

'Show Word
WordApp.Visible = True

'Release Word objects
Set WordDoc = Nothing
Set WordApp = Nothing

'End
Exit Sub

ExitTheSub:
'In case of user quitting, turn events on, tell user they aborted
Call TOGGLEEVENTS(True)
MsgBox "Process aborted.", vbCritical, "ABORTED!"

End Sub
This references code in another module...
Public Sub TOGGLEEVENTS(blnState As Boolean)
'Originally written by Zack Barresse
With Application
If Not blnState And Not ActiveWorkbook Is Nothing Then .Calculation = xlCalculationManual
.DisplayAlerts = blnState
.EnableEvents = blnState
.ScreenUpdating = blnState
If blnState Then .CutCopyMode = False
If blnState Then .StatusBar = False
If blnState And Not ActiveWorkbook Is Nothing Then .Calculation = xlCalculationAutomatic
End With
End Sub
And for simplicity (there are quite a few other routines in this workbook), I put most of my variables in another module, as they're accessed from other routines as well. Here are the applicable one's...
Option Explicit

Public WordApp As Word.Application
Public WordDoc As Word.Document
Public WordMM As Word.MailMerge

Public WB As Workbook
Public WS As Worksheet
Public wbNew As Workbook
Public wsNew As Worksheet

Public iLastRow As Long

Public sPrompt As String
Public sTemp As String
Public sName As String
Public sPath As String

Public msgAsk As VbMsgBoxResult

If you notice in the code I am using Late Binding, but my variables are Early. I changed it to early in trying to debug my code to find out what the problem was. I am probably going to go back to Late Binding, although I don't have to, and can do either/or.

[Zack Barresse]

Bump :rolleyes:

[macropod]

Hi Zack,

Re:

the document does not seem to be linking to the data source specified
Do you mean it isn't finding the data source when your macro runs, or that the saved document doesn't find it later on when opened manually?

[Zack Barresse]

The data source doesn't show on the document, like it didn't set. I haven't done much mail merge via VBA, so I'm not sure what's going on. It fails on the OpenDataSource line with a 5922 run-time error 'Word was unable to open the data source'.

WordDoc.MailMerge.OpenDataSource Name:=sNewXL, LinkToSource:=True, SQLStatement:="SELECT * FROM Sheet1$"

The 'sNewXL' variable was what I just renamed the other variable to, since it's used multiple times, but I checked and it is the correct file path for the Excel file (xlsx format) with the data source.

[macropod]

Hi Zack,

Let's look at the code you have from 'Open a Word application' down.

With this line:

Set WordDoc = WordApp.Documents.Add(sPath & sName)
you're telling Word to create a new document based on a template. However, the 'template' isn't a template at all, it's a document, whose name is set by:

sName = "Quarterly Training Hours.docx"
and whose path is set by:

sPath = ThisWorkbook.Path
A template would be a dotx file (eg "Quarterly Training Hours.dotx"). As you're using a document, you should probably be using code like:

Set WordDoc = WordApp.Documents.Open(Filename:=sPath & sName, AddToRecentFiles:=False)

Since you previously set the name and path of the data source with:

'Get current users desktop path, set file name to be used
sTemp = "C:\Documents and Settings\" & Environ("USERNAME") & "\Desktop\" & Replace(WS.Name, " ", "") & "forMailMerge.xlsx"
and saved the data file to that location, it would seem that re-setting it via:

'Set temporary name for data source
sTemp = sPath & Left(sName, Len(sName) - 4) & "xlsx"
is erroneous. I'd suggest commenting-out that line and the later line that restores sTemp to its previous setting. That should let word find its data source.

I'm also curious as to why you use 'Application.PathSeparator' a few times (eg when setting sPath), whereas everywnere else you seem happy to use "\".

[Zack Barresse]

I could save the file as a template I guess. It's a dotx file right now, and I was opening a new file based off that one, which works as intended. As far as the Application.PathSeparator, I think I only typed that in out of habit, it's not needed here, this isn't going anywhere except for me.

I checked the string variable name at run time, it is what it should be, the file is there and contains the correct data, but it still fails. I'm not really sure why it's not setting. Should I try something else?

[macropod]

Hi Zack,

The first time you set sTemp, it points to:
C:\Documents and Settings\USERNAME\Desktop\Sheet1forMailMerge.xlsx
According to your code's comments above the first 'sTemp =' line, that is the file to be used for the mailmerge.

The second time you set sTemp, it points to:
C:\Users\USERNAME\Document Path\Quarterly Training Hours.xlsx

Clearly, both can't be correct. Does the file referred to in the second version even exist?

Try:
Sub MoveDataForMailMerge(Optional Placebo As Variant)
'Check if activesheet is the master data or table of contents name
If ActiveSheet.Name = MasterData.Name Or ActiveSheet.Name = TOC.Name Then
MsgBox "You must select a quarter sheet first (not the Master Data sheet).", vbExclamation, "ERROR!"
Exit Sub
End If
'Make sure this is the action the user wants to take
sPrompt = "Do you want to copy this data to a new workbook for use with Mail Merge?"
msgAsk = MsgBox(sPrompt, vbYesNo + vbDefaultButton2, "APPEND DATA?")
If msgAsk <> vbYes Then Exit Sub
'Set variables
iLastRow = 2
Set WS = ActiveSheet
'Turn off application events
Call TOGGLEEVENTS(False)
'Create a new (blank) workbook for data transfer
Set wbNew = Workbooks.Add(xlWBATWorksheet)
Set wsNew = wbNew.Worksheets(1)
With wsNew
'Add header rows to new workbook
.Range("A1:I1").Value = Array("Year", "Quarter", "FirstName", "LastName", "Hour", "Minute", "TotalHours", "CBT", "Met Quota")
'Go through first table, add data to new destination workbook as desired
For Each rCell In WS.Range("A5:A" & WS.Cells(WS.Rows.Count, "A").End(xlUp).Row).Cells
'Just in case there's a blank row in the table...
If rCell.Value <> "" Then
'Add data
.Cells(iLastRow, 1).Value = Split(WS.Name, " ")(1)
.Cells(iLastRow, 2).Value = Split(WS.Name, " ")(0)
.Cells(iLastRow, 3).Resize(1, 6).Value = rCell.Resize(1, 6).Value
.Cells(iLastRow, 9).Value = "Yes"
.Cells(iLastRow, 7).Value = -Int(-.Cells(iLastRow, 7).Value * 100) / 100
iLastRow = iLastRow + 1
End If
Next rCell
'Go through second table, add data to new destination workbook as desired
For Each rCell In WS.Range("H5:H" & WS.Cells(WS.Rows.Count, "H").End(xlUp).Row).Cells
'Just in case there's a blank row in the table...
If rCell.Value <> "" Then
'Add data
.Cells(iLastRow, 1).Value = Split(WS.Name, " ")(1)
.Cells(iLastRow, 2).Value = Split(WS.Name, " ")(0)
.Cells(iLastRow, 3).Resize(1, 6).Value = rCell.Resize(1, 6).Value
.Cells(iLastRow, 9).Value = "No"
.Cells(iLastRow, 7).Value = -Int(-.Cells(iLastRow, 7).Value * 100) / 100
iLastRow = iLastRow + 1
End If
Next rCell
End With
'Get current users desktop path, set file name to be used
sTemp = "C:\Documents and Settings\" & Environ("USERNAME") & "\Desktop\" & Replace(WS.Name, " ", "") & "forMailMerge.xlsx"
'Check if the file exists there already
If Dir(sTemp, vbNormal) <> "" Then
'If file exists there already, ensure user wants to continue (delete, create and save)
sPrompt = "It appears a file already exists. Delete existing and save over?" & DNL & "Word should not be open."
msgAsk = MsgBox(sPrompt, vbYesNo + vbDefaultButton2, "DONE")
If msgAsk <> vbYes Then
'New file doesn't need to do anything, get rid of it and go to exit
wbNew.Close False
GoTo ExitTheSub
End If
'Continuing (user wants to continue), delete file
Kill sTemp
End If
'Save new workbook in xlsx format, then close it
wbNew.SaveAs sTemp, 51
sName = wbNew.Name
wbNew.Close
'Open a Word application
On Error Resume Next
Set WordApp = GetObject(, "Word.Application")
If WordApp Is Nothing Then
Set WordApp = CreateObject("Word.Application")
End If
On Error GoTo 0
'Set path (template file should reside in the SAME FOLDER as master data file)
sPath = ThisWorkbook.Path
'Ensure ending character is a path separator, if not, add it
If Right(sPath, 1) <> "\" Then sPath = sPath & "\"
'Open a new document based on template
Set WordDoc = WordApp.Documents.Add(sPath & "Quarterly Training Hours.dotx")
'Create letter mail merge
With WordDoc.MailMerge
.MainDocumentType = 0 'wdFormLetters
'Link to data source
.OpenDataSource Name:=sTemp, LinkToSource:=True, SQLStatement:="SELECT * FROM Sheet1$"
'Set mail merge specifics
.Destination = 0 'wdSendToNewDocument
.SuppressBlankLines = True
.DataSource.FirstRecord = 1 'First Record
.DataSource.LastRecord = .DataSource.RecordCount 'Last Record
Dim mDoc As Document
'Execute mail merge
Set mDoc = .Execute(Pause:=False)
End With
'Set new temp variable to users desktop, this time for the Word doc
sTemp = sPath & Left(sName, InStrRev(sName, ".")) & "docx"
'Check if file exists, if it does, delete it
If Dir(sTemp, vbNormal) <> "" Then Kill sTemp
'Save Word document
WordDoc.SaveAs2 sTemp
'Ensure original Excel workbook is the active file
WB.Parent.Activate
'Turn Excel properties back on
Call TOGGLEEVENTS(True)
'Signal user all is well
MsgBox "Process completed successfully!", vbExclamation, "COMPLETE!"
'Show Word
WordApp.Visible = True
'Release Word objects
Set WordDoc = Nothing: Set WordApp = Nothing
'End
Exit Sub
ExitTheSub:
'In case of user quitting, turn events on, tell user they aborted
Call TOGGLEEVENTS(True)
MsgBox "Process aborted.", vbCritical, "ABORTED!"
End Sub
You'll notice a few extra tweaks to the Excel processing and for setting the save name for the mailmerge main document which, I gather, is to be saved back to the same folder as the original workbook.

[Zack Barresse]

So basically there are two master files, which reside on the server and are mapped to another drive (G). I have the Excel file which I keep all my data. Well I want to do a mail merge, so I have my custom Ribbon and one of the buttons is tied to this routine, which should gather the data, save it to a new file on the local desktop, then create a new document based on the Word master, and use the newly created Excel file as the data source.

As far as the two sTemp values, the second one is incorrect. I had added a new variable after the first post, but the way you have it works just as well. I tried implementing the changes but I get a compile error on this line..

Set mDoc = .Execute(Pause:=False)

'mDoc' was declared as a 'Word.Document', and highlighted is the Execute command.

[macropod]

Hi Zack,

As far as the two sTemp values, the second one is incorrect.
Which is why I queried it in post #5.

Delete the 'Set mDoc = ' - it's from something else I was trying out & forgot to delete from the code I posted.

[Zack Barresse]

No go, still fails on setting the data source.

Should I keep the data source file open until it's set, then close it? Right now the variable is setup to grab only the name, but once closed it can't find the data source (path). Argh. Mail Merge is starting to chap my backside.

[macropod]

Hi Zac,

On my system (Win 7), I needed to change the 1st instance of sTemp to:

sTemp = "C:\Users\" & Environ("USERNAME") & "\Desktop\" & Replace(WS.Name, " ", "") & "forMailMerge.xlsx"
I also needed to change the .OpenDataSource statement:

.OpenDataSource Name:=sTemp, LinkToSource:=True, SQLStatement:="SELECT * FROM `Sheet1$`"
Note the formatted single quotes for `Sheet1$`.

[Zack Barresse]

Same error same line. I double checked and the variables passed are correct for the file path/name. The sheet is named 'Sheet1' as it is by default. Anything else you can think of? The next step I was going to try was to use two test files and only write code to do a mail merge with the two. I'm not sure what's going on.

[macropod]

Are you sure you're using formatted single quotes for `Sheet1$`? 'Sheet1' won't work.

[Zack Barresse]

I wasn't using apostrophe's in the beginning, as there was no spaces, but did have the following dollar sign in the SQL statement. We are just finishing up a complete restructure of our network, so I haven't had the chance to work on it in a few days, hence my delay in posting. I'll try the apostrophe.