Is Word Open, I my doc open? 1

[Cloonalt]

Can anyone point me to some code that they use successfully that will check to see if Word is open, if not, open it. Then, check to see if a specific document is open and if not, open it.

Can't seem to do this cleanly.

Any help is appreciated.

 

[easyit]

Hi,

Use "fIsAppRunning" to check if a app is running (paste the following code in a module):

'***************** Code Start ***************
'This code was originally written by Dev Ashish.
'It is not to be altered or distributed,
'except as part of an application.
'You are free to use it in any application,
'provided the copyright notice is left unchanged.
'
'Code Courtesy of
'Dev Ashish
'
Private Const SW_HIDE = 0
Private Const SW_SHOWNORMAL = 1
Private Const SW_NORMAL = 1
Private Const SW_SHOWMINIMIZED = 2
Private Const SW_SHOWMAXIMIZED = 3
Private Const SW_MAXIMIZE = 3
Private Const SW_SHOWNOACTIVATE = 4
Private Const SW_SHOW = 5
Private Const SW_MINIMIZE = 6
Private Const SW_SHOWMINNOACTIVE = 7
Private Const SW_SHOWNA = 8
Private Const SW_RESTORE = 9
Private Const SW_SHOWDEFAULT = 10
Private Const SW_MAX = 10

Private Declare Function apiFindWindow Lib "user32" Alias _
    "FindWindowA" (ByVal strClass As String, _
    ByVal lpWindow As String) As Long

Private Declare Function apiSendMessage Lib "user32" Alias _
    "SendMessageA" (ByVal hwnd As Long, ByVal Msg As Long, ByVal _
    wParam As Long, lParam As Long) As Long
    
Private Declare Function apiSetForegroundWindow Lib "user32" Alias _
    "SetForegroundWindow" (ByVal hwnd As Long) As Long
    
Private Declare Function apiShowWindow Lib "user32" Alias _
    "ShowWindow" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
    
Private Declare Function apiIsIconic Lib "user32" Alias _
    "IsIconic" (ByVal hwnd As Long) As Long
    Private Const WM_CLOSE = &H10
Private Const INFINITE = &HFFFFFFFF

Private Declare Function apiPostMessage _
    Lib "user32" Alias "PostMessageA" _
    (ByVal hwnd As Long, _
    ByVal wMsg As Long, _
    ByVal wParam As Long, _
    lParam As Any) _
    As Long

Private Declare Function apiWaitForSingleObject _
    Lib "kernel32" Alias "WaitForSingleObject" _
    (ByVal hHandle As Long, _
    ByVal dwMilliseconds As Long) _
    As Long
    
Private Declare Function apiIsWindow _
    Lib "user32" Alias "IsWindow" _
    (ByVal hwnd As Long) _
    As Long
        
Private Declare Function apiGetWindowThreadProcessId _
    Lib "user32" Alias "GetWindowThreadProcessId" _
    (ByVal hwnd As Long, _
    lpdwProcessID As Long) _
    As Long

    
Function fIsAppRunning(ByVal strAppName As String, _
        Optional fActivate As Boolean) As Boolean
    Dim lngH As Long, strClassName As String
    Dim lngx As Long, lngTmp As Long
    Const WM_USER = 1024
    On Local Error GoTo fIsAppRunning_Err
    fIsAppRunning = False
    Select Case LCase$(strAppName)
        Case "excel":       strClassName = "XLMain"
        Case "word":        strClassName = "OpusApp"
        Case "access":      strClassName = "OMain"
        Case "powerpoint95": strClassName = "PP7FrameClass"
        Case "powerpoint97": strClassName = "PP97FrameClass"
        Case "notepad":     strClassName = "NOTEPAD"
        Case "paintbrush":  strClassName = "pbParent"
        Case "wordpad":     strClassName = "WordPadClass"
        Case Else:          strClassName = vbNullString
    End Select
    
    If strClassName = "" Then
        lngH = apiFindWindow(vbNullString, strAppName)
    Else
        lngH = apiFindWindow(strClassName, vbNullString)
    End If
    If lngH <> 0 Then
        apiSendMessage lngH, WM_USER + 18, 0, 0
        lngx = apiIsIconic(lngH)
        If lngx <> 0 Then
            lngTmp = apiShowWindow(lngH, SW_SHOWNORMAL)
        End If
        If fActivate Then
            lngTmp = apiSetForegroundWindow(lngH)
        End If
        fIsAppRunning = True
    End If
fIsAppRunning_Exit:
    Exit Function
fIsAppRunning_Err:
    fIsAppRunning = False
    Resume fIsAppRunning_Exit
End Function
'******************** Code End ****************

Function fCloseApp(lpClassName As String) As Boolean
'************** Code Start ***************
' This code was originally written by Dev Ashish.
' It is not to be altered or distributed,
' except as part of an application.
' You are free to use it in any application,
' provided the copyright notice is left unchanged.
'
' Code Courtesy of
' Dev Ashish
'


'Usage Examples:
'   To close Calculator:
'       ?fCloseApp("SciCalc")
'
Dim lngRet As Long, hwnd As Long, pID As Long

    hwnd = apiFindWindow(lpClassName, vbNullString)
    If (hwnd) Then
        lngRet = apiPostMessage(hwnd, WM_CLOSE, 0, ByVal 0&)
        Call apiGetWindowThreadProcessId(hwnd, pID)
        Call apiWaitForSingleObject(pID, INFINITE)
        fCloseApp = Not (apiIsWindow(hwnd) = 0)
    End If
End Function
'************* Code End ***************

This code opens a word document based on a template. It is used for mailmerge, it produces a data file and a letter which are merged. You should be able to extract the code you need from this:

Dim strPathToWordtemplate As String
Dim strQueryName As String
Dim strMailMergeDataFilename As String
Dim strmailMergeDocumentName As String
Dim strDocName As String
Dim i As Integer

Dim objWordDoc  As Word.Application

If selLetter = true Then
    strPathToWordtemplate = "C:\MyTemplate.dot"
    strmailMergeDocumentName = "c:\temp\MyNewDoc_" & Format(Date, "yyyymmdd") & "_letter1.doc"
    strMailMergeDataFilename = "c:\temp\MyNewDoc_" & Format(Date, "yyyy_mm_dd") & "_datafile_letter1.txt"
    
    strQueryName = "MyQueryname"
    
    'Export the text file to be used as datafile in the mailmerge proces.
    DoCmd.TransferText acExportDelim, "", strQueryName, strMailMergeDataFilename, True

    
    'Create the worddocument
    Set objWordDoc = New Word.Application
    
    objWordDoc.Visible = True
    objWordDoc.WindowState = wdWindowStateMaximize
    objWordDoc.Documents.Add Template:=(strPathToWordtemplate)
    
    strDocName = objWordDoc.ActiveDocument.name
    
    objWordDoc.ActiveDocument.MailMerge.OpenDataSource _
        name:=strMailMergeDataFilename, _
        ConfirmConversions:=False, _
        ReadOnly:=False, _
        LinkToSource:=True, _
        AddToRecentFiles:=False, _
        PasswordDocument:="", _
        PasswordTemplate:="", _
        WritePasswordDocument:="", _
        WritePasswordTemplate:="", _
        Revert:=False, _
        Format:=0, _
        Connection:="", _
        SQLStatement:="", _
        SQLStatement1:=""
    
    objWordDoc.ActiveDocument.MailMerge.Destination = wdSendToNewDocument 'wdSendToNewDocument = document ipv printer, scherm of email.
    
    'Check of template document en datadocument geladen zijn -> voer merge uit als dat zo is
    If objWordDoc.ActiveDocument.MailMerge.State = wdMainAndDataSource Then objWordDoc.ActiveDocument.MailMerge.Execute
    
    'Cleaning up the letter; double spaces are being removed.
    objWordDoc.ActiveDocument.ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument
    objWordDoc.Selection.Find.ClearFormatting
    objWordDoc.Selection.Find.Replacement.ClearFormatting
    'voorbereiden van zoek en vervangen...
    objWordDoc.Selection.Find.Text = "  "
    objWordDoc.Selection.Find.Replacement.Text = ""
    objWordDoc.Selection.Find.Forward = True
    objWordDoc.Selection.Find.Wrap = wdFindAsk
    objWordDoc.Selection.Find.Format = False
    objWordDoc.Selection.Find.MatchCase = False
    objWordDoc.Selection.Find.MatchWholeWord = False
    objWordDoc.Selection.Find.MatchWildcards = False
    objWordDoc.Selection.Find.MatchSoundsLike = False
    objWordDoc.Selection.Find.MatchAllWordForms = False
    '...and execute
    objWordDoc.Selection.Find.Execute Replace:=wdReplaceAll
    
    '...repeat this for sentences that start with a space after a pagebreak
    objWordDoc.Selection.Find.Text = "^p "
    objWordDoc.Selection.Find.Replacement.Text = "^p"
    objWordDoc.Selection.Find.Execute Replace:=wdReplaceAll
    
    'The active document is now ready for merging. We give this document another name
    objWordDoc.ActiveDocument.SaveAs strmailMergeDocumentName
    
    For i = 1 To objWordDoc.Documents.Count
        Debug.Print objWordDoc.Documents(i).name
        objWordDoc.Documents(i).Activate
        If objWordDoc.Documents(i).name = strmailMergeDocumentName Then
            objWordDoc.ActiveDocument.Close SaveChanges:=wdDoNotSaveChanges
        ElseIf objWordDoc.Documents(i).name = strDocName Then
           objWordDoc.ActiveDocument.Close SaveChanges:=wdDoNotSaveChanges
        End If
    Next i
    objWordDoc.Quit SaveChanges:=wdDoNotSaveChanges
    Set objWordDoc = Nothing
End If 
[/code

EasyIT

"Do you think that’s air you're breathing?

 

[Cloonalt]

Thanks for sharing that. I'll use what I can and keep it for future reference.

 

[Remou]

GetObject will show if word is running, it will also allow you to check open documents. For example:

Sub GetWordFileX()
'References Word Library
'See: KB Article ID : 237337 : WD2000: How to Use (OLE) Automation with Word
'[URL unfurl="true"]http://support.microsoft.com/kb/237337[/URL]
Dim app As Word.Application
Dim strFile As String
Dim doc As Word.Document
Dim strWordDocName

strWordDocName = "C:\Docs\Tek-Tips.doc"

On Error Resume Next

Set app = GetObject(, "Word.Application")

If Err Then
    Exit Sub
End If

app.Visible = True
    
If app.Documents.Count > 0 Then
    For Each doc In app.Documents
        If doc.Path & "\" & doc.Name = strWordDocName Then
           Debug.Print doc.Name
        End If
    Next
End If
End Sub