CODEWITHSUNDEEP
excelms-wordvba
chris
chris

Reputation: 25

VBA code to open word doc not working

I have searched thru other posts for this topic but can not find a solution. I want to run some VBA code in excel 2016 (on an imac running OS 10.13.5) to open a word document (preferably as Read Only). If an instance of word is already running, I want to close it before proceeding. (It would be nice if word is already running to be asked if I wanted to save the other instance(s) before closing them.) The code I have is

Private Sub CommandButton1_Click()
Dim w As Object
' If word is already open get ahold of the running instance
' Otherwise create a new instance
On Error Resume Next
Set w = GetObject(, "Word.Application")
If w Is Nothing Then Set w = CreateObject("Word.Application")  
On Error GoTo 0
' Close all open files and shutdown Word
' Loop through any open documents and close them
Do Until w.Documents.Count = 0
    w.Documents(1).Close
Loop
w.Quit False
Set w = Nothing
' Now that all instances of word are closed, open the template
Dim wdApp As Object
Dim wdDoc As Object
Set wdApp = CreateObject("Word.application")  
wdApp.Visible = True
wdApp.DisplayAlerts = False
MYPATH = "Volumes/256SSD/""How to do stuff""/""myfile.docx"""
Set wdDoc = wdApp.Documents.Open(FileName:=MYPATH)
End Sub

When I run this with word already open, I get variable results. Sometimes the code runs thru the "do until loop" and seems to close the open word instances then proceeds to the last line and gives a vba runtime error "Application-defined or object-defined error". A word instance has been started and is awaiting input of which file to be opened.

If I immediately run the code again, the "do until loop" is not entered and word come asking for file name input. VBA gives a run time error "Automation error". I can then select a file name from Recent Files and this is opened but the run time error remains and the file selected in MYPATH is not opened.

I would appreciate some help on this.

Upvotes: 1

Views: 3035

Answers (2)

rpmathur 12
rpmathur 12

Reputation: 55

If you want to close all open word documents and application , just paste the code in module then call this "FindAndCloseAllWordApplications" subroutine from you vba code, i am using windows API from excel VBA

Private Declare PtrSafe Function EnumWindows Lib "user32" (ByVal lpEnumFunc As LongPtr, ByVal lParam As LongPtr) As Long

Private Declare PtrSafe Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hWnd As LongPtr, ByVal lpString As String, ByVal cch As Long) As Long

Private Declare PtrSafe Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hWnd As LongPtr, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long

Private Declare PtrSafe Function IsWindowVisible Lib "user32" (ByVal hWnd As LongPtr) As Long

Private Declare PtrSafe Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As LongPtr, ByVal wMsg As Long, ByVal wParam As LongPtr, ByVal lParam As LongPtr) As Long

Private Const WM_CLOSE As Long = &H10

Private Const MAX_PATH As Long = 260

Private Function EnumWindowsProc(ByVal hWnd As LongPtr, ByVal lParam As LongPtr) As Long

    Dim sClassName As String
    Dim sWindowName As String
    Dim lRet As Long
    
    sClassName = String$(MAX_PATH, vbNullChar)
    lRet = GetClassName(hWnd, sClassName, MAX_PATH)
    
    If lRet > 0 Then
        sClassName = Left$(sClassName, lRet)
        
        ' Check if the window is a Word application
        If InStr(1, sClassName, "OpusApp", vbTextCompare) > 0 Then
            sWindowName = String$(MAX_PATH, vbNullChar)
            lRet = GetWindowText(hWnd, sWindowName, MAX_PATH)
            If lRet > 0 Then
                sWindowName = Left$(sWindowName, lRet)
                Debug.Print "Found Word Application: " & sWindowName
                ' Close the Word application window
                SendMessage hWnd, WM_CLOSE, 0, 0
            End If
        End If
    End If
    
    EnumWindowsProc = 1

End Function

------------------
Public Sub FindAndCloseAllWordApplications()

    EnumWindows AddressOf EnumWindowsProc, 0

End Sub

Upvotes: 0

chris neilsen
chris neilsen

Reputation: 53136

The first part of your code needs work.

  1. It won't close all instances of Word if there are more than one running
  2. If no already open instance of Word is found, it creates one then immediately closes it.

This part could be refactored as

Dim w As Object
On Error Resume Next
    Set w = GetObject(, "Word.Application")
On Error GoTo 0
Do Until w Is Nothing
    Do Until w.Documents.Count = 0
        w.Documents(1).Close SaveChanges:=-2
    Loop
    w.Quit SaveChanges:=0
    Set w = Nothing
    On Error Resume Next
        Set w = GetObject(, "Word.Application")
    On Error GoTo 0
Loop
On Error GoTo 0

Upvotes: 1

Related Questions