I have the following code which works great in Excel 2003. It also works in Excel 2010 if the workbook is an Excel 2003 workbook.
This section of a complex VBA program is intended to open Microsoft Word, then have Word generate a sheet of mailing labels by reaching inside of Excel, finding the table entitled _A_Label_Table , and drawing information for the labels from that table. It uses a word document that I provide called "Label_Template" (it is a .doc document, not a .dot document though) for the format.
The program has worked great with Excel 2003 for many years, and still works fine in other versions of Excel if the program is saved as and Excel 2003 workbook. However, if it is saved as a macro-enabled workbook, the code no longer works. It cannot seem to find the table inside of the Excel file. The program crashes at the long statement starting with 'ActiveDocument.mailmerge...'
I am a retired self-taught senior citizen so my background is weak at best. The program is used at weekend events for high school students. It is in use about once a week between now and the end of November, and I do not know what to do to fix it. I have displayed the code below (with some lengthy message statements deleted - and with notes as to what the statements are for). Can anyone help me?? I am in a bind and need a quick solution. Thank you very much.
This section of a complex VBA program is intended to open Microsoft Word, then have Word generate a sheet of mailing labels by reaching inside of Excel, finding the table entitled _A_Label_Table , and drawing information for the labels from that table. It uses a word document that I provide called "Label_Template" (it is a .doc document, not a .dot document though) for the format.
The program has worked great with Excel 2003 for many years, and still works fine in other versions of Excel if the program is saved as and Excel 2003 workbook. However, if it is saved as a macro-enabled workbook, the code no longer works. It cannot seem to find the table inside of the Excel file. The program crashes at the long statement starting with 'ActiveDocument.mailmerge...'
I am a retired self-taught senior citizen so my background is weak at best. The program is used at weekend events for high school students. It is in use about once a week between now and the end of November, and I do not know what to do to fix it. I have displayed the code below (with some lengthy message statements deleted - and with notes as to what the statements are for). Can anyone help me?? I am in a bind and need a quick solution. Thank you very much.
Code:
Dim i As Integer
Dim sPath As String
Dim WrdApp As Object ' This is done for 'late binding' - used in this sub (Object rather than dimensioning as an Application)
Dim WrdDoc As Object
Dim wbName As String
'
sPath = ThisWorkbook.Path
'
'
On Error GoTo ErrHandler:
If Dir(sPath & "\" & "Label_Template.doc") <> "" Then
Else
MsgBox "OOPS!"
'
Exit Sub
End If
'
Set WrdApp = CreateObject("Word.Application") ' This is 'late binding' for Word (Late Binding requires all Microsoft Word items to be converted to numbers)
WrdApp.Visible = True ' This statment insures Word screen is visible to the user
WrdApp.Application.WindowState = 2 ' This statement minimizes the Word display screen
Set WrdDoc = WrdApp.Documents.Open(sPath & "\Label_Template.doc") ' This statment opens the Template
With WrdApp
.DisplayAlerts = 0
.Application.WindowState = 2 ' This minimizes the Word display screen in the event user had redisplayed it
.ScreenUpdating = False ' This freezes the screen to speed up the macro
.ActiveDocument.MailMerge.MainDocumentType = 3 ' This defines the MailMerge document as a 'Directory' document
' ====================
' PROBLEM STATEMENT FOLLOWS
' ====================
.ActiveDocument.MailMerge.OpenDataSource Name:= _
wbName, _
ConfirmConversions:=False, ReadOnly:=False, LinkToSource:=True, _
AddToRecentFiles:=False, PasswordDocument:="", PasswordTemplate:="", _
WritePasswordDocument:="", WritePasswordTemplate:="", Revert:=False, _
Format:=0, Connection:= _
"Provider=Microsoft.ACE.OLEDB.12.0;User ID=Admin;Data Source=wbName;Mode=Read;Extended Properties=""HDR=YES;IMEX=1;"";Jet OLEDB:System database="""";Jet OLEDB:Registry Path="""";Jet OLEDB:Engine Type=35" _
, SQLStatement:="SELECT * FROM `__A_Label_Table`", SQLStatement1:="", _
SubType:=1 ' This defines the source for the MailMerge Directory
'
With WrdApp.ActiveDocument.MailMerge
.Destination = 0 ' This tells MailMerge to create a new document
.SuppressBlankLines = True ' This supresses blank lines
With .DataSource
.FirstRecord = 1
.LastRecord = -16
End With
.Execute Pause:=False ' This executes the MailMerge without pausing between entries
.Application.WindowState = 2
End With
.ActiveDocument.SaveAs Filename:=sPath & "\My_Show_Labels.doc", FileFormat _
:=0, LockComments:=False, Password:="", AddToRecentFiles:= _
True, WritePassword:="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts:= _
False, SaveNativePictureFormat:=False, SaveFormsData:=False, _
SaveAsAOCELetter:=False ' This defines the name of the new My_Show_Labels Document
.ActiveDocument.Close (-1) '(wdSaveChanges) ' This saves the new My_Show_Labels document, saving it
.ActiveDocument.Close (0) '(wdDoNotSaveChanges) ' This closes the Template, restoring it to its original condition
.ScreenUpdating = True ' This resets the screen updating
End With
'
If MsgBox("The program has generated a Ready-to-Print sheet of standard 1 inch by 2-5/8 inch mailing labels. Do you want to view the labels at this time?", vbYesNo, "USER INFORMATION") = vbYes Then
Set WrdDoc = WrdApp.Documents.Open(sPath & "\My_Show_Labels.doc")
'
Application.ScreenUpdating = False
ActiveWindow.WindowState = xlMaximized ' This statement makes certain that Excel is fully visible when Word is closed later
WrdApp.Application.WindowState = 1 ' This maximizes Word application for viewing in front of Excel in window
Else
WrdApp.Quit ' This closes the Word application
ActiveWindow.WindowState = xlMaximized ' This restores the window for viewing Excel
End If
'
Application.ScreenUpdating = True
Set WrdDoc = Nothing
Set WrdApp = Nothing
Exit Sub