PDA

View Full Version : End all word processes



rm7885
04-16-2015, 08:14 AM
Hello, I am trying to end all word processes when closing word, I have the code in an AutoClose macro, as well as additional code that is used to remove a mapped drive that appears if a user opens a template using a shortcut. When i try to close word, i get prompted about saving changes, and since it prompts me about saving changes, word will not close and it causes me to get the error "You cannot close Microsoft Word because a dialog box is open. Click Ok, switch to Word, and then close the dialog box." I have tried a few different things to prevent the save prompt from appearing with no luck. All I want is all of the word processes to end after it has done the work to see if that network drive has been disconnected.

This is the code i have


Sub AutoClose()


Dim wordisrunning As Boolean
Dim wdApp As Word.Application
Dim strResponse As String
Dim a(100000), i, fs, d, dc, s, n
Dim reqdShare, foundFlag, myFileRef, Msg, style, Title
Dim myDrive, mapDrive As String
Dim objNetwork, objShell, CheckDrive As Object


' if the user uses a shortcut when selecting a template, a network drive is mapped.
' We need to disconnect the network mapping to avoid their drive letters being all
' used up. The following code takes care of this for all drives except R: that are
' pointing to the VM server.


reqdShare = "\\av-riscvmfegl01\Sharedapps"


' Determine if computer is mapped to the required shared file server...

Set fs = CreateObject("Scripting.FileSystemObject")
Set dc = fs.Drives


' Loop through each mapped drive...

For Each d In dc
n = d.ShareName
If n = reqdShare Then
myDrive = d.DriveLetter
If myDrive <> "R" Then
sDrive = myDrive & ":"
With CreateObject("WScript.Network").EnumNetworkDrives
For i = 0 To .Count - 1 Step 2
If .Item(i) = sDrive Then
Set objShell = CreateObject("WScript.Shell")
Set objNetwork = CreateObject("WScript.Network")
Set AllDrives = objNetwork.EnumNetworkDrives()
Set myDrive = CreateObject("WScript.Network")
myDrive.RemoveNetworkDrive sDrive
End If
Next
End With
End If
End If
Next


On Error Resume Next
' end all word processes to prevent Outlook from becoming unresponsive


wordisrunning = True

Do While wordisrunning = True
Set wdApp = GetObject(, "Word.Application")
If Err.Number <> 0 Then
Err.Clear
wordisrunning = False
End If
If wordisrunning = True Then

ActiveDocument.Close SaveChanges:=wdDoNotSaveChanges
wdApp.Application.Quit SaveChanges:=False
Set wdApp = Nothing
End If

Loop



End Sub

rm7885
04-27-2015, 09:03 AM
I have tried using the following:


Sub AutoClose()
'Close all open files and shutdown Word

With Application
.ScreenUpdating = False

'Loop Through open documents
Do Until .Documents.Count = 0
'Close no save
Documents(1).Close SaveChanges:=wdDoNotSaveChanges
Loop

'Quit Word no save
.Quit SaveChanges:=wdDoNotSaveChanges
End With
End Sub

But I got a debug error at the line which says "Documents(1).Close SaveChanges:=wdDoNotSaveChanges", the error says:
Run-time error '4198':
Command failed

Any ideas?