I'm wondering if anyone has a simple answer to this, because I am a novice with VBA/programming. I created a form letter using VBA automation to Word from Access using a crosstab query as my data source. It works beautifully. But, if you try running it a second time without closing the document that was just created, it causes Word to crash. The same thing happens if I already have a Word document open before running the code. This is a problem because my end users may have all sorts of documents open when they try to run this code (they'll just think they're running a report). I don't want to have to tell them that they have to close any instances of Word before running my code. It should just run as many times as they push the button. Is there anything I can do? I can't make sense of any of the other posts I've read related to this.
Here's my code if it helps (initially I used early binding but then switched to late binding to see if that made a difference - it didn't):
Code:
Private Sub Command0_Click()
'Late Binding
Dim WordApp As Object, doc As Object
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim fld As Field
Dim intLoop As Integer
Set WordApp = New Word.Application
Set doc = WordApp.Documents.Add
With WordApp
.Visible = True
.Activate
.WindowState = wdWindowStateNormal
End With
Set db = CurrentDb()
Set rs = db.OpenRecordset("Faculty_Crosstab_Qry_TEST_Crosstab")
Do Until rs.EOF
'Set line spacing and alignment
With WordApp.Selection.ParagraphFormat
.LeftIndent = InchesToPoints(0)
.RightIndent = InchesToPoints(0)
.SpaceBefore = 0
.SpaceBeforeAuto = False
.SpaceAfter = 0
.SpaceAfterAuto = False
.LineSpacingRule = wdLineSpaceSingle
.Alignment = wdAlignParagraphLeft
.WidowControl = True
.KeepWithNext = False
.KeepTogether = False
.PageBreakBefore = False
.NoLineNumber = False
.Hyphenation = True
.FirstLineIndent = InchesToPoints(0)
.OutlineLevel = wdOutlineLevelBodyText
.CharacterUnitLeftIndent = 0
.CharacterUnitRightIndent = 0
.CharacterUnitFirstLineIndent = 0
.LineUnitBefore = 0
.LineUnitAfter = 0
.MirrorIndents = False
.TextboxTightWrap = wdTightNone
End With
WordApp.Selection.Font.Name = "Calibri"
WordApp.Selection.Font.Size = 11
'Introduction Section
WordApp.Selection.TypeText rs.Fields(2) & vbCrLf & vbCrLf
WordApp.Selection.TypeText "Dear " & rs.Fields(0) & " " & rs.Fields(1) & "," & vbCrLf & vbCrLf
WordApp.Selection.TypeText "This email confirms the invitation recently extended to you to be a speaker at the American Society of Health-System Pharmacists' "
WordApp.Selection.Font.Bold = True
WordApp.Selection.TypeText "2013 ASHP National Pharmacy Preceptors Conference"
WordApp.Selection.Font.Bold = False
WordApp.Selection.TypeText ". This meeting will be held at the Washington Hilton in Washington, DC, August 21 - 23, 2013. On behalf of ASHP, we thank you for accepting this invitation."
WordApp.Selection.TypeText vbCrLf & vbCrLf
'About Your Sessions(s)
WordApp.Selection.Font.Bold = True
WordApp.Selection.Font.UnderlineColor = wdColorAutomatic
WordApp.Selection.Font.Underline = True
WordApp.Selection.TypeText "About Your Sessions(s)" & vbCrLf
WordApp.Selection.Font.Bold = False
WordApp.Selection.Font.Underline = False
WordApp.Selection.TypeText "Your session(s) is/are scheduled for:" & vbCrLf & vbCrLf
'Session List
For intLoop = 6 To rs.Fields.Count - 1
If Not IsNull(rs.Fields(intLoop)) Then
WordApp.Selection.TypeText rs.Fields(intLoop) & vbCrLf
Else: WordApp.Selection.TypeText ""
End If
Next
WordApp.Selection.TypeText vbCrLf
'Compensation
WordApp.Selection.Font.Bold = True
WordApp.Selection.Font.UnderlineColor = wdColorAutomatic
WordApp.Selection.Font.Underline = True
WordApp.Selection.TypeText "Compensation"
WordApp.Selection.Font.Bold = False
WordApp.Selection.Font.Underline = False
WordApp.Selection.TypeText vbCrLf & "In recognition of your contribution to the meeting, ASHP will provide you with the following:" & vbCrLf
'Begin Bulleted List
WordApp.ListGalleries(wdBulletGallery).ListTemplates(1).Name = ""
WordApp.Selection.Range.ListFormat.ApplyBulletDefault
'Bullet 1
WordApp.Selection.Font.Bold = True
WordApp.Selection.TypeText Text:="Complimentary Registration"
WordApp.Selection.TypeText Text:=Chr(11)
WordApp.Selection.Font.Bold = False
WordApp.Selection.Font.Italic = True
WordApp.Selection.TypeText "Do not WordApp.Selectionf-register; ASHP will register you. Non-transferrable. You will be issued a confirmation by mid-July."
WordApp.Selection.Font.Italic = False
WordApp.Selection.TypeParagraph
'Bullet 2
If Not IsNull(rs.Fields(4)) Then
WordApp.Selection.Font.Bold = True
WordApp.Selection.TypeText Text:=Format(rs.Fields(4), "$#,##0") & " Honorarium"
WordApp.Selection.Font.Bold = False
WordApp.Selection.TypeParagraph
Else: WordApp.Selection.TypeText ""
End If
'Bullet 3
If Not IsNull(rs.Fields(5)) Then
WordApp.Selection.Font.Bold = True
WordApp.Selection.TypeText Text:=Format(rs.Fields(5), "$#,##0") & " Expenses"
WordApp.Selection.Font.Bold = False
WordApp.Selection.TypeParagraph
Else: WordApp.Selection.TypeText ""
End If
'Bullet 4
WordApp.Selection.Font.Bold = True
WordApp.Selection.TypeText Text:="New! Please make your own hotel arrangements this year." & Chr(11)
WordApp.Selection.Font.Bold = False
WordApp.Selection.TypeText Text:="To make reservations, call 202-483-3000; be sure to mention the "
WordApp.Selection.Font.Bold = True
WordApp.Selection.TypeText Text:="ASHP National Pharmacy Preceptors Conference, code [PHP]"
WordApp.Selection.Font.Bold = False
WordApp.Selection.TypeText Text:=", to receive the special group rate. Room rates are $169 per night for single and double occupancy plus 14.5% tax. To ensure this rate and availability, reservations must be made by "
WordApp.Selection.Font.Bold = True
WordApp.Selection.TypeText Text:="Thursday, July 31, 2013"
WordApp.Selection.Font.Bold = False
WordApp.Selection.TypeText Text:=". After this date, reservations will be accepted on a space and rate availability basis. Cancellations must be received 72 hours prior to the scheduled date of arrival; deposits are not refunded for cancellations made fewer than 72 hours prior to arrival date."
WordApp.Selection.TypeParagraph
WordApp.Selection.Range.ListFormat.ApplyBulletDefault 'End Bullet List
WordApp.Selection.TypeText vbCrLf
WordApp.Selection.Paragraphs.Outdent
WordApp.Selection.Font.Bold = True
WordApp.Selection.Font.Underline = True
WordApp.Selection.TypeText "Deadlines" & vbCrLf
'Create Left-indent of 0.5" and hanging indent of 1"
With WordApp.Selection.ParagraphFormat
.LeftIndent = InchesToPoints(1)
.SpaceBeforeAuto = False
.SpaceAfterAuto = False
End With
With WordApp.Selection.ParagraphFormat
.SpaceBeforeAuto = False
.SpaceAfterAuto = False
.FirstLineIndent = InchesToPoints(-1)
End With
With WordApp.Selection.ParagraphFormat
.SpaceBeforeAuto = False
.SpaceAfterAuto = False
.FirstLineIndent = InchesToPoints(-0.5)
End With
WordApp.Selection.Font.Bold = False
WordApp.Selection.Font.Underline = False
WordApp.Selection.TypeText "April 1"
WordApp.Selection.TypeText Text:=vbTab
WordApp.Selection.TypeText "- Complete your disclosure and presenter agreements online." & Chr(11) & " "
WordApp.Selection.TypeText Chr(11) & "- Submit your completed W-9." & Chr(11) & " "
WordApp.Selection.TypeText vbCrLf & "July 1"
WordApp.Selection.TypeText Text:=vbTab & "- Slides due (ASHP will email you the template)"
WordApp.Selection.TypeText vbCrLf & "July 31"
WordApp.Selection.TypeText Text:=vbTab & "- Deadline to secure hotel reservations at the discounted group rate." & vbCrLf & vbCrLf
'Move back the indents to proper place before proceeding to next letter
With WordApp.Selection.ParagraphFormat
.LeftIndent = InchesToPoints(0)
.SpaceBeforeAuto = False
.SpaceAfterAuto = False
End With
With WordApp.Selection.ParagraphFormat
.SpaceBeforeAuto = False
.SpaceAfterAuto = False
.FirstLineIndent = InchesToPoints(0.5)
End With
With WordApp.Selection.ParagraphFormat
.SpaceBeforeAuto = False
.SpaceAfterAuto = False
.FirstLineIndent = InchesToPoints(0)
End With
WordApp.Selection.Font.Bold = True
WordApp.Selection.Font.Underline = True
WordApp.Selection.TypeText "Important Documents" & vbCrLf
WordApp.Selection.Font.Bold = False
WordApp.Selection.Font.Underline = False
WordApp.Selection.TypeText "These attachments contain important instructions for your presentation at the meeting. "
WordApp.Selection.TypeText "Please read them carefully." & vbCrLf & vbCrLf
'Numbered List
WordApp.ListGalleries(wdNumberGallery).ListTemplates(1).Name = ""
WordApp.Selection.Range.ListFormat.ApplyListTemplateWithLevel ListTemplate:= _
ListGalleries(wdNumberGallery).ListTemplates(1), ContinuePreviousList:= _
False, ApplyTo:=wdListApplyToWholeList, DefaultListBehavior:= _
wdWord10ListBehavior
'Number 1
WordApp.Selection.Font.Bold = True
WordApp.Selection.TypeText Text:="PRESENTER HANDBOOK"
WordApp.Selection.Font.Bold = False
WordApp.Selection.TypeText " - contains information on..."
WordApp.Selection.TypeText Text:=Chr(11)
'Pseudo sub-bullets
WordApp.Selection.InsertSymbol Font:="Calibri", CharacterNumber:=8226, Unicode:=True
WordApp.Selection.TypeText " Slides"
WordApp.Selection.TypeText Text:=Chr(11)
WordApp.Selection.InsertSymbol Font:="Calibri", CharacterNumber:=8226, Unicode:=True
WordApp.Selection.TypeText " Active Learning - required for ALL sessions"
WordApp.Selection.TypeText Text:=Chr(11)
WordApp.Selection.InsertSymbol Font:="Calibri", CharacterNumber:=8226, Unicode:=True
WordApp.Selection.TypeText " Abstracts"
WordApp.Selection.TypeText Text:=Chr(11)
WordApp.Selection.InsertSymbol Font:="Calibri", CharacterNumber:=8226, Unicode:=True
WordApp.Selection.TypeText " AV"
WordApp.Selection.TypeText Text:=Chr(11)
WordApp.Selection.InsertSymbol Font:="Calibri", CharacterNumber:=8226, Unicode:=True
WordApp.Selection.TypeText " What to expect onsite"
WordApp.Selection.TypeText Text:=Chr(11)
WordApp.Selection.Font.Bold = False
WordApp.Selection.TypeParagraph
'Number 2
WordApp.Selection.Font.Bold = True
WordApp.Selection.TypeText Text:="SCHEDULE-AT-A-GLANCE"
WordApp.Selection.Font.Bold = False
WordApp.Selection.TypeText Text:=Chr(11)
WordApp.Selection.Font.Bold = False
WordApp.Selection.TypeParagraph
'Number 3
WordApp.Selection.Font.Bold = True
WordApp.Selection.TypeText Text:="COPYRIGHT HANDBOOK"
WordApp.Selection.Font.Bold = False
WordApp.Selection.TypeText " - details the appropriate use of images, graphs, charts, etc. within your presentation."
WordApp.Selection.TypeText Text:=Chr(11)
WordApp.Selection.Font.Bold = False
WordApp.Selection.TypeParagraph
'End Numbered List
WordApp.Selection.Range.ListFormat.ApplyListTemplateWithLevel ListTemplate:=ListGalleries(wdNumberGallery).ListTemplates(1)
'Reset bullets so the remaining letters aren't completely bulleted
WordApp.Selection.Range.ListFormat.RemoveNumbers NumberType:=wdNumberParagraph
WordApp.Selection.Paragraphs.Outdent
WordApp.Selection.TypeText "Thank you in advance for your cooperation and response to our many requests. We are very excited about your participation in making this our most successful meeting yet!"
WordApp.Selection.TypeText vbCrLf & vbCrLf & "Sincerely," & vbCrLf & vbCrLf
WordApp.Selection.TypeText "Michelle C. Abalos, PharmD" & vbCrLf
WordApp.Selection.TypeText "Director, Educational Programs"
'Page Break
WordApp.Selection.InsertBreak Type:=wdPageBreak
rs.MoveNext
Loop
Set doc = Nothing
Set WordApp = Nothing
End Sub