Question

我在Access 2010中有一个VB表单，它打开一个文件对话框以进行Excel选择。我将文件路径作为字符串发送到我的变量：directory（directory = strPath）以打开工作簿并将其内容复制到我当前的工作簿。如果您打算一次使用该工具，哪个工作正常。导入一个文件，然后在同一目录中发生错误的另一个文件。

非工作示例：

选择C：\ Desktop \ File1.xls，导入
选择C：\ Desktop \ File2.xls，导入

错误：

运行时错误＆＃39; 1004＆＃39;：
一个名为＆＃39; Tool.xlsm＆＃39;的文档。已经开放了。即使文档位于不同的文件夹中，也无法打开具有相同名称的两个文档。要打开第二个文档，请关闭当前打开的文档，或重命名其中一个文档。

工作示例（单独的文件夹）：

选择C：\ Desktop \ File1.xls，导入
选择C：\ 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

在DEBUG模式下，它不喜欢

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 = false，您打开的Wb将触发其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

VBA打开工作簿错误

2 个答案: