Results 1 to 6 of 6
  1. #1
    besuchanko is offline Advanced Beginner
    Windows XP Access 2007
    Join Date
    Jan 2013
    Posts
    32

    Automation to Word Crash

    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

  2. #2
    Rod is offline Expert
    Windows 7 32bit Access 2007
    Join Date
    Jun 2011
    Location
    Metro Manila, Philippines
    Posts
    679
    I could be way off base here but ...

    Set WordApp = New Word.Application
    opens a new Word application. So what's wrong with that? Well some applications such as Access require a new copy for every opened item whereas others such as Outlook (and Word?) require only one copy of the application and then open each item subordinate to that single copy.

    What I believe is happening is that you are getting multiple copies of Word and this really screws up the object referencing something rotten.

    So what to do? Here's a fragment of code that I use to open Word.

    Code:
        'Create reference to existing Word application or create a new one.
        
        On Error Resume Next
        Set mdocApp = GetObject(, "Word.Application")
        Select Case Err.Number
        Case 0
            On Error GoTo OpenApplication_Error
        Case 429
            On Error GoTo OpenApplication_Error
            Set mdocApp = CreateObject("Word.Application")
        Case Else
            GoTo OpenApplication_Error
        End Select
    The logic is that I first try to set a reference to an open Word application using the GetObject function. If this fails with error 429 (no open Word application) then I create one using the CreateObject function.

    Post back if you need more help.

  3. #3
    besuchanko is offline Advanced Beginner
    Windows XP Access 2007
    Join Date
    Jan 2013
    Posts
    32
    I appreciate your help. I copied your code and adjusted it to match mine. But I'm getting this error message: "Label not defined."

    It's referencing this line:

    On Error GoTo OpenApplication_Error

    What am I doing wrong?

  4. #4
    Rod is offline Expert
    Windows 7 32bit Access 2007
    Join Date
    Jun 2011
    Location
    Metro Manila, Philippines
    Posts
    679
    Sorry, my code was an example not a solution. If you don't have error handling then replace all instances of On Error GoTo OpenApplication_Error
    with On Error GoTo 0 (that's a zero). You need to use your own variable names too.

  5. #5
    besuchanko is offline Advanced Beginner
    Windows XP Access 2007
    Join Date
    Jan 2013
    Posts
    32
    Thank you so much for your help. Your advice and sample code was just enough to help me solve the problem. I was able to get everything working the way I want by using the code below.

    Code:
    On Error Resume Next
    Set WordApp = GetObject(, "Word.Application")
    If Err.Number <> 0 Then
        Set WordApp = CreateObject("Word.Application")
    End If

  6. #6
    Rod is offline Expert
    Windows 7 32bit Access 2007
    Join Date
    Jun 2011
    Location
    Metro Manila, Philippines
    Posts
    679
    Two words of caution: you should test for the specific error number, 429; you should switch VBA's error handling back on.

    You cannot be certain that the GetObject function will fail with error 429. I agree it is the most likely error but not necessarily the only error.

    'On Error Resume Next' will persist throughout the module. Thus if a subsequent error occurs elsewhere the code execution will resume with the next statement and no error will be reported. You should switch VBA's default error handling back on by 'On Error Goto 0.'

Please reply to this thread with any new information or opinions.

Similar Threads

  1. Automation to Word using Crosstab Query
    By besuchanko in forum Import/Export Data
    Replies: 3
    Last Post: 07-22-2013, 03:19 PM
  2. Replies: 2
    Last Post: 04-19-2012, 12:43 PM
  3. Replies: 11
    Last Post: 01-26-2012, 09:28 AM
  4. Word Automation in Windows 7
    By tmbowden in forum Access
    Replies: 0
    Last Post: 01-23-2012, 01:17 PM
  5. Access and Word Automation
    By djreyrey in forum Forms
    Replies: 1
    Last Post: 01-08-2010, 02:33 PM

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  
Other Forums: Microsoft Office Forums