VBA打開工作簿錯誤

Question

我在Access 2010中有一個VB窗體，打開一個文件對話框來進行Excel選擇。我將文件路徑作爲字符串發送到我的變量：目錄（directory = strPath）以打開工作簿並將其內容複製到我當前的工作簿中。如果你打算一次使用這個工具，那工作正常。這是當你導入一個文件，然後另一個在相同的目錄中發生錯誤。

---

不工作的例子：

選擇C：\桌面\ File1.xls，進口
選擇C：\桌面\ File2.xls，進口

錯誤：

Run-time error '1004':
A document with the name 'Tool.xlsm' is already open. You cannot open two documents with the same name, even if the documents are in different folders. To open the second document, either close the document that's currently open, or rename one of the documents.

---

工作實例（單獨文件夾）：

選擇C：\桌面\ File1.xls，進口
選擇C：\桌面\ TestFolder \ File2.xls，進口

---

Public Sub CommandButton1_Click() 
    Dim intChoice As Integer 
    Dim strPath As String 
    Application.EnableCancelKey = xlDisabled 
    'only allow the user to select one file 
    Application.FileDialog(msoFileDialogOpen).AllowMultiSelect = False 
    'make the file dialog visible to the user 
    intChoice = Application.FileDialog(msoFileDialogOpen).Show 
    'determine what choice the user made 
    If intChoice <> 0 Then 
     'get the file path selected by the user 
     strPath = Application.FileDialog(_ 
      msoFileDialogOpen).SelectedItems(1) 
     'print the file path to sheet 1 
     TextBox1 = strPath 
    End If 

End Sub 

Public Sub CommandButton2_Click() 
    Dim directory As String, FileName As String, sheet As Worksheet, total As Integer 
    Application.ScreenUpdating = False 
    Application.DisplayAlerts = False 


    directory = strPath 
    FileName = Dir(directory & "*.xls") 


    Do While FileName <> "" 
    Workbooks.Open (directory & FileName) 

    For Each sheet In Workbooks(FileName).Worksheets 
     total = Workbooks("Tool.xlsm").Worksheets.Count 
     Workbooks(FileName).Worksheets(sheet.name).Copy _ 
     after:=Workbooks("Tool.xlsm").Worksheets(total) 
    Next sheet  

    Workbooks(FileName).Close  

    FileName = Dir() 

    Loop 

    Application.ScreenUpdating = True 
    Application.DisplayAlerts = True  
    Application.EnableCancelKey = xlDisabled 
    Application.DisplayAlerts = False 

End Sub 

在調試模式下它不喜歡

Workbooks.Open (directory & FileName) 

任何建議，以消除此錯誤？

Answer 1

首先，在目錄和FileName之間，我假設有一個「\」。

其次，簡單地檢查工作簿已經打開：

dim wb as workbook 

err.clear 
on error resume next 
set wb = Workbooks (FileName) 'assuming the "\" is not in FileName 
if err<>0 or Wb is nothing then 'either one works , you dont need to test both 
    err.clear 
    set wb= Workbooks.Open (directory & FileName) 
end if 
on error goto 0 

，如果你不使用application.enableevents =假，你打開白平衡將觸發其workbook_open事件！

Answer 2

我想發佈工作代碼，也許它將在未來幫助某人。再次感謝那些留下評論的人。

此代碼將打開一個文件對話框，允許用戶選擇1個excel文件，然後將所選文件中的所有工作表複製到當前工作簿中。

Public Sub CommandButton1_Click() 
Dim intChoice As Integer 
Application.EnableCancelKey = xlDisabled 
'only allow the user to select one file 
Application.FileDialog(msoFileDialogOpen).AllowMultiSelect = False 
'make the file dialog visible to the user 
intChoice = Application.FileDialog(msoFileDialogOpen).Show 
'determine what choice the user made 
If intChoice <> 0 Then 
    'get the file path selected by the user 
    strPath = Application.FileDialog(_ 
     msoFileDialogOpen).SelectedItems(1) 
    'print the file path to textbox1 
    TextBox1 = strPath 
End If 

End Sub 

Public Sub CommandButton2_Click() 
Dim directory As String, FileName As String, sheet As Worksheet, total As Integer 
Dim wb As Workbook 

Application.ScreenUpdating = False 
Application.DisplayAlerts = False 

Err.Clear 
On Error Resume Next 
Set wb = Workbooks(FileName) 'assuming the "\" is not in FileName 
If Err <> 0 Or wb Is Nothing Then 'either one works , you dont need to test both 
    Err.Clear 
    Set wb = Workbooks.Open(directory & TextBox1) 
End If 
On Error GoTo 0  


    FileName = Dir(directory & TextBox1)  

    Do While FileName <> "" 
    Workbooks.Open (directory & TextBox1) 

    For Each sheet In Workbooks(FileName).Worksheets 
     total = Workbooks("NAMEOFYOURWORKBOOK.xlsm").Worksheets.Count 
     Workbooks(FileName).Worksheets(sheet.name).Copy _ 
     after:=Workbooks("NAMEOFYOURWORKBOOK.xlsm").Worksheets(total) 
    Next sheet 

    Workbooks(FileName).Close 

    FileName = Dir() 

    Loop 

Application.ScreenUpdating = True 
Application.DisplayAlerts = True 
Application.EnableCancelKey = xlDisabled 
Application.DisplayAlerts = False 


End Sub