VBA打开工作簿错误
我在Access 2010中有一个VB窗体，打开一个文件对话框来做一个Excelselect。 我将文件path作为string发送到我的variables：directory（ directory = strPath ）以打开工作簿并将其内容复制到我当前的工作簿。 如果你打算一次使用这个工具，那工作正常。 这是当你导入一个文件，然后在同一个目录中的另一个错误发生。
非工作示例：
selectC：\ Desktop \ File1.xls，导入
selectC：\ Desktop \ File2.xls，导入
错误：
运行时错误“1004”：
名称为“Tool.xlsm”的文档已经打开。 即使文档位于不同的文件夹中，也无法打开两个具有相同名称的文档。 要打开第二个文档，请closures当前打开的文档，或者重命名其中一个文档。
工作示例（单独文件夹）：
selectC：\ Desktop \ File1.xls，导入
selectC：\ Desktop \ 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
在debugging模式下，它不喜欢
Workbooks.Open (directory & FileName)
任何build议，以消除这种错误的方式？
首先，在目录和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 = false，则打开的Wb将触发其workbook_open事件！
我想发布工作代码，也许这将有助于未来的人。 再次感谢那些留下评论的人。
此代码将打开文件对话框，允许用户select1 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