Creating and Editing Word Doc from within Excel; Procedure Randomly Stops

Hi everyone. I hope I can get some insight here.

Using Office 97/Win 2k Pro and Office 2003/Win XP Pro, same results.

I have a workbook that creates a Word document using a command button and userform. The command button calls the user form, data is entered by the user, and when a command button on the user form is clicked, the document is generated.

Sometimes, I can step through the procedure, and it will work all the way through. Sometimes, it seems as if I step through too fast, the procedure seems to just stop without warning, and will not go any further. If I try to run the procedure by simply clicking the command button, it will never run all the way through.

The procedure that is generating the Word document is as follows:

Sub CreateSampleRequestLetter()

    Dim wrdApp As Word.Application
    Dim wrdDoc As Word.Document
    Dim wrdTmp As Word.Document
    Dim rng As Word.Range
    Dim strTemp As String
    Dim Ans
    
    Application.ScreenUpdating = False
    
    Set wrdApp = CreateObject("Word.Application")
    Set wrdDoc = wrdApp.Documents.Open _
        ("http://*****.doc")
    Set wrdTmp = wrdApp.Documents.Open _
        ("http://*****.dot")
    
Sometimes it will stop within this With statement:
    With wrdDoc.PageSetup
        .DifferentFirstPageHeaderFooter = True
        .LeftMargin = InchesToPoints(1)
        .RightMargin = InchesToPoints(1)
        .TopMargin = InchesToPoints(1)
        .BottomMargin = InchesToPoints(1)
        .FirstPageTray = wdPrinterManualFeed
        .OtherPagesTray = wdPrinterManualFeed
    End With
    
Sometimes it will stop within this With statement:
    With wrdDoc.Sections(1)
        .Headers(wdHeaderFooterFirstPage).Range.Delete
        .Headers(wdHeaderFooterPrimary).Range.Delete
        .Footers(wdHeaderFooterFirstPage).Range.Delete
        .Footers(wdHeaderFooterPrimary).Range.Delete
    End With
    
    Set rng = wrdTmp.Sections(1).Headers(wdHeaderFooterFirstPage).Range
    rng.Copy
    With wrdDoc.Sections(1).Headers(wdHeaderFooterFirstPage)
        .Range.Paste
        .Shapes(1).IncrementLeft -30.75
    End With
    wrdTmp.Close False

    Set rng = wrdDoc.Content

Sometimes it will stop while the document is being edited (at random points):
'Makes all applicable changes to the letter content, based on user form data.
    With wrdApp.Selection
        .WholeStory
        .ParagraphFormat.RightIndent = InchesToPoints(0)  'remove right indent
        
        With .Font                              'correct font size and type
            .Size = 10
            .Name = "Palatino Linotype"
        End With
        .HomeKey wdStory
        
        .MoveDown wdLine, 1, wdExtend           'delete exhibit name
        .Delete wdCharacter, 1
        .HomeKey wdStory
        
        With .Find                              'change indents for bulleted list
            .Text = "UB ("
            .Execute
        End With
        .HomeKey wdLine
        .MoveDown wdLine, 7, wdExtend
        .MoveRight wdCharacter, 1, wdExtend
        With .ParagraphFormat
            .TabStops(InchesToPoints(0.75)).Clear
            .LeftIndent = InchesToPoints(0.5)
            .RightIndent = InchesToPoints(0.25)
        End With
        .HomeKey wdStory
        
        With .Find                              'removes paragraph spacing on subj line
            .Text = "SUBJECT"
            .Execute
        End With
        .HomeKey wdLine
        With .ParagraphFormat
            .SpaceBefore = 0
            .SpaceAfter = 0
        End With
        .HomeKey wdStory
        
        With .Find                              'delete extra line before subject
            .Text = "subject"
            .Execute
        End With
        .HomeKey wdLine
        .TypeBackspace
        .HomeKey wdStory
        
        With .Find                              'insert current date
            .Text = "<Date>"
            .Replacement.Text = Format(Date, "mmmm d, yyyy")
            .Execute Replace:=wdReplaceOne
        End With
        .HomeKey wdStory
        
        With .Find                              'insert on-site review date & time
            .Text = "<Date>"
            .Replacement.Text = Format(frmSampleReqLetter.txtOnsiteDate, "mmmm d, yyyy")
            .Execute Replace:=wdReplaceAll
        End With
        .HomeKey wdStory
        With .Find
            .Text = "<Time>"
            .Replacement.Text = frmSampleReqLetter.cboOnsiteTime
            .Execute Replace:=wdReplaceOne
        End With
        .HomeKey wdStory
        
        With .Find                              'insert contact name & title
            .Text = "<Contact Name> <Contact Title>"
            With frmSampleReqLetter
                strTemp = .cboMrMs & .txtContName1 & " " & .txtContName2 & _
                    ", " & .txtContTitle
            End With
            .Replacement.Text = strTemp
            .Execute Replace:=wdReplaceOne
            strTemp = ""
        End With
        .HomeKey wdStory
        
        With .Find                              'insert salutation
            .Text = "Dear:"
            .Replacement.Text = "Dear " & frmSampleReqLetter.cboMrMs & _
                frmSampleReqLetter.txtContName2 & ":"
            .Execute Replace:=wdReplaceOne
        End With
        .HomeKey wdStory
        
        With .Find                              'insert provider name
            .Text = "<Facility Name>"
            .Replacement.Text = frmSampleReqLetter.txtProvName
            .Execute Replace:=wdReplaceOne
        End With
        .HomeKey wdStory
        With .Find
            .Text = "<Provider Name>"
            .Replacement.Text = frmSampleReqLetter.txtProvName
            .Execute Replace:=wdReplaceOne
        End With
        .HomeKey wdStory
        
        With .Find                              'insert provider number
            .Text = "<Provider #>"
            .Replacement.Text = frmSampleReqLetter.txtProvNo
            .Execute Replace:=wdReplaceOne
        End With
        .HomeKey wdStory
        
        With .Find                              'insert provider address
            .Text = "<Facility Address>"
            .Replacement.Text = frmSampleReqLetter.txtAddress1
            .Execute Replace:=wdReplaceOne
        End With
        .HomeKey wdStory
        With .Find
            .Text = "<Facility City, State, Zip Code>"
            .Replacement.Text = frmSampleReqLetter.txtAddress2
            .Execute Replace:=wdReplaceOne
        End With
        .HomeKey wdStory
        
        With .Find                              'insert intial letter date
            .Text = "<Date of Initial Notification Letter>"
            .Replacement.Text = Format(frmSampleReqLetter.txtInitLetter, "mmmm d, yyyy")
            .Execute Replace:=wdReplaceOne
        End With
        .HomeKey wdStory
        
        With .Find                              'insert auditor phone number
            .Text = "<Manager's Telephone Number>"
            .Replacement.Text = frmSampleReqLetter.txtAudPhone
            .Execute Replace:=wdReplaceOne
        End With
        .HomeKey wdStory
        
        With .Find                              'insert auditor name & title
            .Text = "<Manager Name>"
            With frmSampleReqLetter
                strTemp = .txtAudName & Chr(13) & .txtAudTitle
            End With
            .Replacement.Text = Chr(13) & strTemp
            .Execute Replace:=wdReplaceOne
            strTemp = ""
        End With
        .HomeKey wdStory
        
        With .Find                              'remove PAD from signature line
            .Text = "Provider Audit Department"
            .Replacement.Text = ""
            .Execute Replace:=wdReplaceOne
        End With
        .TypeBackspace
'        If Answer = vbNo Then
'            .EndKey wdStory
'            .TypeBackspace
'            .HomeKey wdStory
'            With .Find                              'insert auditor phone number
'                .Text = frmSampleReqLetter.txtAudTitle
'                .Execute
'            End With
'            .HomeKey wdLine
'            .TypeBackspace
'            .TypeText ", "
'        End If
        .HomeKey wdStory
    
    End With
        
    Application.ScreenUpdating = True
    
    With wrdApp
        .Visible = True
        .Activate
    End With
    
    Dialogs(wdDialogFileSaveAs).Show

    frmSampleReqLetter.Hide

End Sub

Thanks in advance for any input.

Jason

Jason

Tried some parts of this and managed to get so far. Created a couple of temp documents (xxx.doc and xxxx.dot) on C:\temp to give it something to work with and it only bombed out when it came to finding some of the items on the document.

Can you put up a sample of the word doc and template (nothing sensitive) that we can use to work with. Gets a bit difficult trying to replicate all your items....


rylo

Thanks for the reply, Rylo. I will post up the files when I return to work on Monday.

Jason

Ok, here are the files. On the 2008 Log.xls file (password is "password"), I changed the name of the files in the code to refer to:

C:\Temp\DM.doc

and

C:\Temp\LH.dot

DM.doc is the letter that is opened and modified. LH.dot is our company's letterhead that is opened, header copied, and closed. Please save both of these to C:\Temp to properly work.

The code to open and edit the Word document is in Module2. I did make several changes to the Excel and Word files, since some of the information was proprietary, but it should still work as intended.

If it works for you the first time, please close Word and try it again. Every once in a while it will work for me just fine. But if I try it again, it will not work properly. I moved the visibility and activation of the Word app to the beginning of the procedure, in order to help see the stopping point of the code.

Again, I really appreciate any help on this issue.

Jason

Jason

I didn't have trouble with this until it tried to do the find. I'm not much for word macros, but couldn't find the syntax in Excel to do the find in word. Could do a word macro, but not in excel.

There was also the problem that "UB (" didn't seem to exist.

Can you get the excel code to do a find in word, then select the text???

rylo

Hi, rylo.

Yeah, you can delete the few lines of code that try to find that text string. I deleted that when I was editing the file to be posted. Sorry about that.

As for using Excel to search in Word, I'm not sure how to do that... I created that code basically by recording a macro in Word, then copying and pasting after I got it to where it needed to be.

Any other ideas?

TIA

Jason