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
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