2014-03-07 50 views
0

我正在通過VBA使用以下代碼從Access打開工作簿。我需要檢查該工作簿是否已經打開:如果已經打開,則不要執行任何操作,否則用CreateObject方法打開它。代碼如下:檢查通過VBA在MS Access內訪問的工作簿是否打開

Dim oAppa As Object 
Dim filea As String 
filea = CurrentProject.Path & "\List.xlsm" 
Set oAppa = CreateObject("Excel.Application") 
oAppa.Visible = True 
Set owb_a = oAppa.workbooks.Open(filea, ReadOnly:=True) 

在打開它時,我需要檢查它是否已經打開。請幫助我,提前致謝。

+1

看到我的答案在這裏:http://stackoverflow.com/questions/22150619/how-to-get-data-from-an-already-opened-excel-workbook-with-a-word-macro/22150839# 22150839 –

+0

嗨simoco,感謝您的快速回復,但我需要檢查如果工作簿具有相同的名稱已經打開,那麼不要做任何事情,不要創建新的實例。使用Getobject創建實例,oAppa不會停留在Nothing –

回答

0

你可以通過所有打開的工作簿環,但是這將需要一段時間...

一個簡單的解決方案,從https://stackoverflow.com/a/9373914/2829009

Option Explicit 

Sub Sample() 
    Dim Ret 

    Ret = IsWorkBookOpen("C:\myWork.xlsx") 

    If Ret = True Then 
     MsgBox "File is open" 
    Else 
     MsgBox "File is Closed" 
    End If 
End Sub 

Function IsWorkBookOpen(FileName As String) 
    Dim ff As Long, ErrNo As Long 

    On Error Resume Next 
    ff = FreeFile() 
    Open FileName For Input Lock Read As #ff 
    Close ff 
    ErrNo = Err 
    On Error GoTo 0 

    Select Case ErrNo 
    Case 0: IsWorkBookOpen = False 
    Case 70: IsWorkBookOpen = True 
    Case Else: Error ErrNo 
    End Select 
End Function 
0

我只是回答了一個字幾乎相同的問題所採取。答案是相同(或非常相似):

' Handle Error In-Line 
On Error Resume Next 
Set objExcel = GetObject(, "Excel.Application") 

If Err.Number = 429 Then 
    'If we got an error, that means there was no Excel Instance 
    Set objExcel = CreateObject("Excel.Application") 
Else 
    Msgbox ("You're going to need to close any open Excel docs before you can perform this function.", vbOK) 
    Exit Sub 
End If 

'Reset Error Handler 
On Error GoTo 0 

當然,你可以調整你想要做什麼,如果實例已經存在,而不是剛出子。

相關問題