Warn when the word file is already open

[Visor]

Dear friends of the forum, I have a macro to open my file word which is next to the file excel.
But if the file is already open, it brings me problems

How I can do to alert me if the file is already open, and if so, put exit sub

The code is this:

Private Sub CommandButton1_Click()
Archivo = ThisWorkbook.Path & "\Microbiologia I.docx"
  With CreateObject("word.application")
    .Documents.Open Archivo
    .Visible = True
    .Activate
    End With
End Sub

Advance my thanks

 

[YasserKhalil]

Try this code (Change To Suit)

Sub Open_Word_File()
    Dim strDoc As String
   
    strDoc = ThisWorkbook.Path & "\Sample.docx"
   
    If DocOpen(strDoc) Then
        MsgBox "Already Open", 64
    Else
        With CreateObject("Word.Application")
            .Documents.Open strDoc
            .Visible = True
            .Activate
        End With
    End If
End Sub

Function DocOpen(strDocName As String) As Boolean
    Dim appWord As Object
    Dim wdDoc As Object
   
    On Error Resume Next
    Set appWord = GetObject(, "Word.Application")
    If Err <> 0 Then GoTo ErrorHandler

    With appWord
        Set wdDoc = appWord.Documents(strDocName)
        If Err <> 0 Then GoTo ErrorHandler
    End With
   
    DocOpen = True
    Exit Function
ErrorHandler:
End Function

 

[Visor]

Thanks for the code, works in part ...
The problem:
When I have open or open another file I have
If you use the macro to open "MyWord" file, opens well
But if I click on the button again the macro does not leave me the message "already open"
The file is inhibited

In other cases the message if it works, that is when I do not have another open word file.
Or if first I open MyWord file.



To get unstuck, close the other Word file and MyWord file, after I press Ctrl + Alt + Delete and Manager, end word, then the Excel error message I get, I'll show you the error in the code




Please how I can solve this case.

I have Excel 2013 of 64

Advance my thanks

 

[YasserKhalil]

In fact I have no idea of the reason for this error message .. may be because of excel 2013 (64 bit)
We would wait for experts' replies

 

[jindon]

Sub test()
    Dim fn As String, temp As Boolean
    fn = ThisWorkbook.Path & "\Microbiologia I.docx"
    temp = IsFileOpen(fn)
    MsgBox fn & " is " & IIf(temp, "", "NOT ") & "Open"
End Sub

Function IsFileOpen(fName As String) As Boolean
    Dim ff As Integer, errNum As Integer
    If Dir(fName, 0) = "" Then
        IsFileOpen = False: Exit Function
    End If
    On Error Resume Next
    ff = FreeFile
    Open fName For Input Lock Read As #ff
    Close ff
    errNum = Err
    On Error GoTo 0
    IsFileOpen = (errNum <> 0)
End Function

 

[Visor]

Thanks Jindo, according to the subject is true that your code works.
But what happens when I try to work so that when, .. if MyWord file es closed, then macro open it and if opened, will generate a warning "Already Open" then exit sub.
That's when was failing.
I'll try to get to my house. Then I give notice.
Perhaps this very close to the solution

But I see the code confusing, I do not know where would place the code to make it open if MyWord file is closed, and generate only the message should be open, ... then

 

[jindon]

Use GetObject.

Private Sub CommandButton1_Click()
    Dim fn As String, myWord As Object
    fn = ThisWorkbook.Path & "\Microbiologia I.docx"
    With GetObject(, "word.application")
        If IsFileOpen(fn) Then
            fn = Split(fn, "\")(UBound(Split(fn, "\")))
            Set myWord = .Documents(fn)
        Else
            Set myWord = .Documents.Open(fn)
            .Visible = True
        End If
    End With
    MsgBox myWord.Name
End Sub

 

[Visor]

Fantastic!!!!, is exactly what I wanted. It works very well
I am very grateful
Topic solved

 

[YasserKhalil]

Thanks Mr. Jindon for sharing us
When I tested the last code I encountered an error at this line

fn = ThisWorkbook.Path & "\Microbiologia I.docx"

 

[Visor]

Uploaded according to topic, I think you've helped me a lot.
I uploaded another similar but not the same topic.
However I have indicated that I must continue this same thread
therefore I will repeat what I put there.

With your code I have a way to recognize if the file is closed ered or, to paste a range of excel. If the arcchivo is closed, the macro works fine, but if it is open, there is when I have problems.

This is what I wrote in the other thread:
........." paste this code range MyWord file excel in this closed, then opens it and displays it."

Private Sub CommandButton1_Click()
Hoja8.Range("A1:H32").Select
    Selection.CopyPicture xlScreen, xlPicture
    Archivo = ThisWorkbook.Path & "\Microbiologia I.docx"
  With CreateObject("word.application")
        Selection.CopyPicture xlScreen, xlPicture
        .Documents.Open Archivo
        .Selection.Paste
        .ActiveDocument.SaveAs (Archivo)
        .Visible = True
        .Activate
  End With
End Sub

But what if I want to paste into MyWord file that is already open ???
Error generates the code shown here:
File .Documents.Open (fn)
Because attempts to open a file that is already open.

I tried with the code that the master Jindon, kindly helped me but also it does not work, especially if the file is already open.

Private Sub CommandButton1_Click()
Dim fn As String, myWord As Object
    fn = ThisWorkbook.Path & "\Microbiologia I.docx"
  With GetObject(, "word.application")
      If IsFileOpen(fn) Then 'File is open 
  Hoja8.Range("A1:H32").Select
    Selection.CopyPicture xlScreen, xlPicture
            fn = Split(fn, "\")(UBound(Split(fn, "\")))
          'Set myWord =      
    .Documents (fn)
                .Selection.Paste
                .ActiveDocument.SaveAs (fn)

      Else  'If file es closed
Hoja8.Range("A1:H32").Select
    Selection.CopyPicture xlScreen, xlPicture
          'Set myWord =      
    .Documents.Open (fn)
            .Selection.Paste
        ' CreateObject("word.application") 
     .ActiveDocument.SaveAs (fn)
            .Visible = True
            .Activate

      End If
  End With
    MsgBox myWord.Name 'Ready!!
End Sub

How do I get my file already open,... and copy paste my rang?
I anticipate my thanks

 

[Debaser]

You could simply pass the path to GetObject:

Private Sub CommandButton1_Click()
  Archivo = ThisWorkbook.Path & "\Microbiologia I.docx"
  With GetObject(Archivo)
  .Application.Visible = True
  .Application.Activate
  End With
End Sub

 

[Visor]

Thanks Debaser, but the problem now is to paste the selected range in the file that is already open
I put your code does not work
err 480
Object does not support this property

 

[Debaser]

Use:

.Application.Selection.Paste

or even:

Private Sub CommandButton1_Click()
  Archivo = ThisWorkbook.Path & "\Microbiologia I.docx"
  With GetObject(Archivo).Application
     .Visible = True
     .Selection.Paste
     .Activate
  End With
End Sub

 

[Visor]

yesss!!
Now it works,
I am very grateful Jindo and Debate
express apologies for the theme alarge

Private Sub CommandButton1_Click()
'By Jindon and Debaser
  Dim fn As String, myWord As Object
        Hoja8.Range("A1:H32").Select
        Selection.CopyPicture xlScreen, xlPicture
       
    fn = ThisWorkbook.Path & "\Microbiologia I.docx"
    With GetObject(, "word.application")
        If IsFileOpen(fn) Then 'File is open
            fn = Split(fn, "\")(UBound(Split(fn, "\")))
            .Visible = True
            .Application.Selection.Paste
            .Activate
    '    .ActiveDocument.SaveAs (fn)
        Else    'If file es closed
            .Documents.Open (fn)
            .Selection.Paste
          '.ActiveDocument.SaveAs (fn)
            .Visible = True
            .Activate
        End If
    End With
End Sub

This thread is solved