Evitar abrir el mismo archivo Word desde excel

[raultrres]

Hola, tengo un problema con excel, desde un Commandbutton, y mediante combinar correspondencia, abro y auto relleno un archivo de Word, con el último registro de una tabla Excel. El problema viene cuando al tener abierto ese archivo Word, pulso de nuevo el mismo commandbutton, quedándose el userform bloqueado. Mi duda es como configurar para que al volver a apretar ese commandbutton no inicie la macro comprobando si esta abierto el archivo. Y por último no soy capaz de hacer que al abrir directamente se inicie el guardar como, para así no modificar el archivo base. Copio el código de la combinación de correspondencia.

 Private Sub PORTADA_Click()

    ruta = ThisWorkbook.Path & "\"
    arch = "1.PORTADA.dotm"
     Archivo = ruta & arch
    With CreateObject("word.application")
    If Dir(Archivo) = "" Then
         MsgBox ("No existe el archivo")
             Exit Sub
       Else
     .Documents.Open Archivo
        End If
       .Visible = True
       .Activate
        .ActiveDocument.MailMerge.MainDocumentType = wdFormLetters
  .ActiveDocument.MailMerge.OpenDataSource Name:= _
    ruta & "PRUEBA FINAL MACRO.xlsm" _
    , ConfirmConversions:=False, ReadOnly:=False, LinkToSource:=True, _
    AddToRecentFiles:=False, PasswordDocument:="", PasswordTemplate:="", _
    WritePasswordDocument:="", WritePasswordTemplate:="", Revert:=False, _
    Format:=wdOpenFormatAuto, Connection:= _
    "Provider=Microsoft.ACE.OLEDB.12.0;User ID=Admin;Data Source=" & ruta & "PRUEBA FINAL MACRO.xlsm;Mode=Read;Extended Properties=""HDR=YES;IMEX=1;"";Jet OLEDB:System database="""";Jet OLEDB:Registry Path="""";Jet O" _
    , SQLStatement:="SELECT * FROM `'BASE DE DATOS TOTAL$'`", SQLStatement1:= _
    "", SubType:=wdMergeSubTypeAccess
       .ActiveDocument.MailMerge.DataSource.ActiveRecord = wdLastRecord
    .ActiveDocument.MailMerge.ViewMailMergeFieldCodes = wdToggle
    
       End With
       
      End Sub

Un saludo y gracias

[Abraham Valencia]

Hola

Debes hacer algunos cambios. Primero declara una variable así:

Dim MiappWord As Object

Luego, mira este archivo y copia la UDF "IsFileOpen":

Enlace

Esta parte primero y así:

If Dir(Archivo) = "" Then
	MsgBox ("No existe el archivo")
	Exit Sub
End If

Y luego de verificar si existe el archivo, verificamos si está abierto o no:

If IsFileOpen(NombreArchivo) Then
	'si esta abierto
	Set appword = Set appAccess = GetObject(Archivo)
Else
	'si está cerrado
	Set MiappWord = CreateObject("Word.Application")
End If

Y ya lo demás igual haciendo referencia al objeto word creado:

With AppWord

Saludos

Abraham Valencia

[raultrres]

Gracias, como siempre. Voy a ver si lo pruebo. Un saludo