> Puer, see the code below.
> I tried, made changes, tried again, made changes, tried... and so on. It
> seems the moving/changing of the .SaveAs statement did the trick, but I'm
> not sure.
> ==============================
> Private Sub cmdCreateDoc_Click()
> Dim objWord As Word.Application '<=== changed
> Dim objDoc As Word.Document '<=== changed
> Dim strDocNum As String
> Dim objRange As Word.Range '<=== changed
> Dim intLoop As Integer
> On Error GoTo EMailOrderDocument_Error
> ' Set mousepointer to hourglass
> Screen.MousePointer = vbHourglass
> strDocNum = "123456"
> ' Open up the word application
> Set objWord = CreateObject("Word.Application") '<=== added
> ' Make Word visible, can be handy while debugging
> objWord.Visible = True '<=== added
> ' Open up the skeleton word document
> Set objDoc = objWord.Documents.Open(App.Path & "\Quote.doc")
> ' Set the parameters for the skeleton word document
> With objDoc
> ' Replace placeholders with the e-mail info variables
> With .Content.Find
> .Text = "Contact-First-Name"
> .Wrap = wdFindContinue
> .Forward = True
> .Replacement.Text = "Blah Blah"
> .Execute Replace:=wdReplaceAll
> End With
> ' Save new version of document
> .SaveAs "c:\My Documents\Quote-" & strDocNum & ".doc" '<===
changed
> and moved
> ' Close (new version of) document
> .Close '<=== changed
> End With
> EMailOrderDocument_Exit:
> objWord.Quit
> Set objDoc = Nothing '<=== changed
> Set objWord = Nothing '<=== changed
> Screen.MousePointer = vbDefault
> End '<=== Aghhhh -- (sound of sirene)
> 'Hope it's just for this example!!
> EMailOrderDocument_Error:
> MsgBox Err.Number & " " & Err.Description
> Resume EMailOrderDocument_Exit '<=== changed
> End Sub
> ==============================
> Hope this helps,
> Johan.
> | Okay, here's the deal. Below is a pared down version of a subroutine
that
> | the salespeople I work with use hundreds of times a day. It opens a
> | template document, saves it under a new name, and replaces some
> placeholder
> | text that is in the document. Here is the problem. If the subroutine
> gets
> | an error and drops to the error handler, the next time they run the
> | subroutine they get a 'File in use' error. If you go into the Close
> Program
> | box, you will see Winword sitting there. The only way to run the
> subroutine
> | again is to End Task on the Winword, start the program over, and try
> again.
> |
> | But it gets weirder. If the subroutine does not get an error and
follows
> | through successfully, the next time the run the program they get a
'Remote
> | server is unavailable' error. If you go into the Close Program box, you
> | will see 'Word for Windows' sitting there. Once again, they have to End
> | Task, start the program over, and run the routine again.
> |
> | So, every time they want to run the routine, they have one shot at it,
and
> | whether it is successful or not, they have to restart the program and
End
> | Task programs from the Close Program window. This gets very time
> consuming
> | over a period of eight hours.
> |
> | Microsoft in their infinite wisdom suggested that I reinstall Office on
> | every machine that this happens to...every time it happens. Gotta love
> | it...
> |
> | This is being programmed in VB6. The added references I have selected
are
> | as follows:
> | Microsoft Scripting Runtime
> | Microsoft Word 8.0 Object Library
> | Microsoft Office 8.0 Object Library
> |
> | And here is the pared down code:
> |
> | -------------------------------------------
> | Private Sub cmdCreateDoc_Click()
> |
> | Dim objWord As New Word.Application
> | Dim objDoc As Document
> | Dim strDocNum As String
> | Dim objRange As Range
> | Dim intLoop As Integer
> |
> | On Error GoTo EMailOrderDocument_Error
> |
> | ' Set mousepointer to hourglass
> | Screen.MousePointer = vbHourglass
> |
> | strDocNum = "123456"
> |
> | ' Open up the skeleton word document
> | Set objDoc = objWord.Documents.Open(App.Path & "\Quote.doc")
> |
> | ' Set the parameters for the skeleton word document
> | With objDoc
> | ' Save new version of document
> | .SaveAs ("c:\My Documents\Quote-" & strDocNum & ".doc")
> |
> | ' Replace placeholders with the e-mail info variables
> | With .Content.Find
> | .Text = "Contact-First-Name"
> | .Wrap = wdFindContinue
> | .Forward = True
> | .Replacement.Text = "Blah Blah"
> | .Execute Replace:=wdReplaceAll
> | End With
> | .Close (wdSaveChanges)
> | End With
> |
> | EMailOrderDocument_Exit:
> | objWord.Quit
> | If Not (objDoc Is Nothing) Then Set objDoc = Nothing
> | If Not (objWord Is Nothing) Then Set objWord = Nothing
> | Screen.MousePointer = vbDefault
> | End
> |
> | EMailOrderDocument_Error:
> | MsgBox Err.Number & " " & Err.Description
> | GoSub EMailOrderDocument_Exit
> |
> | End Sub
> | ------------------------------------------------
> |
> | Any help would be greatly appreciated. I have been working on this for
> much
> | longer than I would have liked to, and I know that I'm just missing
> | something simple. A second set of eyes would really help.
> |
> | Thanks,
> | Robert Michaud
> |
> |
> |