Проверьте, не открыт ли какой-либо файл Excel

Question

Я использую обширную ссылку Excel-Word, обновленную вручную с помощью кода VBA. Если файл Excel не открыт, Word пытается открыть его, предупреждает, что его открытие снова является проблемой, для чего требуется диалоговое окно, затем перейдите к следующей ссылке и запустите снова. Поскольку, как правило, 100 ссылок, это большая проблема.

Я нашел простой код VBA, который вызывает функцию, чтобы проверить, работает ли Excel.

Dim sApp As String 
    sApp = "Excel.Application" 
    If IsAppRunning(sApp) = True Then 
     MsgBox "Excel is Running, continue" & SourceFileName 
    Else 
     MsgBox "Excel is NOT Running, abort" 
     Exit Sub 
    End If 

Я хочу проверить, открыт ли файл RIGHT Excel. «Правильный» файл будет иметь то же имя, что и файл Word, например, MyDocSample.doc будет связан с MyDocSample.xls.

Если MyDocSample.xls открыт, тогда продолжайте, если нет, должно быть опубликовано предупреждение о том, что «MyDocSample.xls» не открыто и предлагает выбор «Отмена».

Answer 1

Ответ будет выполнен в подфункции IsAppRunning. Вам нужно идентифицировать .Caption каждого окна в объекте приложения Excel и сравнить его с вашим списком.

Function IsAppRunning(ByVal sAppName) As Boolean 
    Dim w As Long, oApp As Object 
    On Error Resume Next 
    Set oApp = GetObject(, sAppName) 
    If Not oApp Is Nothing Then 
     For w = 1 To oApp.Windows.Count 
      Debug.Print w & oApp.Windows(w).Caption 
     Next w 
     Set oApp = Nothing 
     IsAppRunning = True 
    End If 
End Function 

Эта зачаточном функция используется вид зависит от вас использовать только один экземпляр (с возможными несколькими тетрадей) в Excel открыты одновременно. Я не думаю, что он будет циклически проходить через экземпляры приложений.

Answer 2

Вы можете использовать функцию GetObject, чтобы вернуть книгу, если вы знаете имя файла.

Sub foo() 

Dim s As String 
Dim wb As Object 'Excel.Workbook 

s = replace(ActiveDocument.Name, ".doc", ".xls") 'Modify if needed 

Set wb = GetExcelFile(s) 

If wb Is Nothing Then 
    MsgBox "File is not open!" 
    Exit Sub 
End If 


End Sub 

Function GetExcelFile(filename As String) 
Dim obj As Object 'Excel.Workbook 

On Error Resume Next 
Set obj = GetObject(, "Excel.Application").Workbooks(filename) 
On Error GoTo 0 

Set GetExcelFile = obj 

End Function 

Answer 3

Почему бы не перебрать все книги в Excel?

Sub Open_Book() 
    Dim varSheets As Variant 
    Dim booMatch As Boolean 
    Dim strFilePath As String 
    strFilePath = "C:\FullFilePath" 
    booMatch = False 
    For Each varSheets In Application.Workbooks 
     If varSheets.Name = "FileName.xls" Then 
      booMatch = True 
      Exit For 
     End If 
    Next varSheets 
    If booMatch = False Then 
     Workbooks.Open strFilePath 
    End If 
End Sub