inconsistent error

T

TRM

I am using automation to edit/accept changes to some word
documents from Access. The code follows. Occasionally
however, I receive an error "document not open"... It
does not always happen and occurs on the line
reading "With Active Document", next line "Dim lngCounter
as...". I THINK I have also gotten the error, "server
not avaiable" on this same line. Any suggestions??

Thanks for your time and effort!

Dim strSavDir As String
Dim oDoc As Object
Dim varPath As Variant
Dim oApp As Word.Application
Set oApp = GetObject("", "Word.Application")
oApp.Documents.Open (sDocName)
If strSW = "S" Then
strSavDir = ROOT_PATH & "drafts\"
Else
strSavDir = ROOT_PATH & "WorkIns\"
End If

With oApp
If strField = "Related" Then
.Selection.Goto wdGoToBookmark,
Name:="Related"
.Selection.Text = sText & "," & " "
'if file has been approved, we can approve
this change automatically, otherwise
'this would accept changes which have not
been approved.
If strSaved = "Y" Then
.Options.DefaultFilePath(wdDocumentsPath)
= "C:\SavedSOPs\"
.ActiveDocument.AcceptAllRevisions
Else
.Options.DefaultFilePath(wdDocumentsPath)
= strSavDir
End If
ElseIf strField = "Approved" Then
Set oDoc = oApp.Documents.Item(1)
Dim strCurrDate As Date
strCurrDate = Forms!Approval!txtDate
oDoc.Variables("DateEdited").Value =
strCurrDate
oDoc.Variables("ApprovedBy").Value = sText
oDoc.Fields.Update
.Options.DefaultFilePath(wdDocumentsPath)
= strSavDir
ElseIf strField = "HRApproved" Then
Set oDoc = oApp.Documents.Item(1)
strCurrDate = Forms!Approval!txtDate
oDoc.Variables("IndexNo").Value = strIndex
oDoc.Variables("DateEdited").Value =
strCurrDate
oDoc.Variables("HRApproved").Value = sText
oDoc.Fields.Update
.Options.DefaultFilePath(wdDocumentsPath)
= "C:\SavedSOPs\"
If strVer = "Original" Then
'edits and updates footer field for
docname
oDoc.Variables("IndexNo2").Value =
strIndex
oDoc.Sections(1).Footers
(wdHeaderFooterPrimary).Range.Fields.Update
.ActiveDocument.AcceptAllRevisions
Else
With ActiveDocument
Dim lngCounter As Long
For lngCounter = 1 To .Sections
(1).Range.Fields.Count
.Fields(lngCounter).Select

Selection.Range.Revisions.AcceptAll
Next
End With
End If
End If
thesave1:
.Documents.Save
End With

oApp.Quit
Set oApp = Nothing
Set oDoc = Nothing
End Function
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top