How to detect if document object has been deleted

[johndavidson]

I am trying to close an array of Word documents, some of which may have already been closed by the user.

Dim arrDoofDocs As Integer
Dim aDoc As Document

aDocArray has the documents that were open when we started but some of which the user may have closed. The code works if the docs are all open

As you can see I have tried On Error and If ... Nothing but to no avail. It hits the "object has been deleted error". What's the correct code?


For i = 1 To arrNoofDocs
Set aDoc = aDocArray(i)
'On Error GoTo SkipClose
'If aDoc Is Nothing Then GoTo SkipClose ' Check if doc is open. User might have closed it
'aDoc.Close
If Not aDoc Is Nothing Then aDoc.Close ' Check if doc is open. User might have closed it
SkipClose:
Next


Thanks

John

[arnelgp]

can you use:

On Error Resume Next

[johndavidson]

Thanks arnelgp, that's done the trick! :yes

[johndavidson]

Hmmm. Spoke too soon. That doesn't always work. I can't see what the difference between the circumstances is but sometimes I still get the "object has been deleted" message. It permits the Set aDoc = aDocArray(i) statement even tho' the document has already been deleted but complains on the aDoc.Close statement.

If I replace the aDoc.Close statement with If Not aDoc Is Nothing Then aDoc.Close it still does not recognize that aDoc is no longer open and goes on to try and execute aDoc.Close which produces the error message. It doesn't 'Resume Next'.


For i = 1 To arrNoofDocs
Set aDoc = aDocArray(i)
On Error Resume Next
If Not aDoc Is Nothing Then aDoc.Close
'aDoc.Close
Next

Any further thoughts?

[arnelgp]

add this code to a Module:

' https://exceloffthegrid.com/vba-find-file-already-open/
Function IsFileOpen(filename As String)


Dim fileNum As Integer
Dim errNum As Integer


'Allow all errors to happen
On Error Resume Next
fileNum = FreeFile()


'Try to open and close the file for input.
'Errors mean the file is already open
Open filename For Input Lock Read As #fileNum
Close fileNum


'Get the error number
errNum = Err


'Do not allow errors to happen
On Error GoTo 0


'Check the Error Number
Select Case errNum


'errNum = 0 means no errors, therefore file closed
Case 0
IsFileOpen = False

'errNum = 70 means the file is already open
Case 70
IsFileOpen = True


'Something else went wrong
Case Else
IsFileOpen = errNum


End Select


End Function


on your code, you also add an array and put
the path + name of the word file that you are working
on:


Public aFiles(1 To X) As String 'X is the total number of files
aFiles(1)="doc path + filename 1 here"
aFiles(2)="doc path + filename 2 here"
' etc...


***********
now on your code make some modification:




For i = 1 To arrNoofDocs
If IsFileOpen(aFiles(i)) <> 0
Set aDoc = aDocArray(i)
On Error Resume Next
If Not aDoc Is Nothing Then aDoc.Close
'aDoc.Close
End If
Next

[johndavidson]

I'm afraid that that doesn't work either. I already have a working IsFileOpen function and in this situation it consistently returns Err = 53


Public Function IsFileOpen(FileName As String)
Dim iFilenum As Long
Dim iErr As Long

On Error Resume Next
iFilenum = FreeFile()
Open FileName For Input Lock Read As #iFilenum
Close iFilenum
iErr = Err
On Error GoTo 0

Select Case iErr
Case 0: IsFileOpen = False
Case 53: IsFileOpen = False ' added for DoTDocs_Click in John.dot frmFRTreasuryPARTs code
Case 70: IsFileOpen = True
Case Else: Error iErr
End Select

End Function


The calling code is:


For i = 1 To arrNoofDocs
Set aDoc = aDocArray(i)
On Error Resume Next
If IsFileOpen(DocNameArray(i)) = True Then aDoc.Close
'aDoc.Close
Next


The file name contains the entire path including C:\ ..., though I tried it without the path as well.

I stepped it through and always get the same error - Err = 53 whether a doc. is open or closed.

Have you tried this code yourself?

Help!!

[johndavidson]

My apologies. The code does work. It was my file names that had an error!!

I hope that's ll fixed now

Thanks for your help.