Блог

У меня есть форма VB в Access 2010, которая открывает диалоговое окно file для выбора Excel. Я отправляю путь к файлу в виде строки в свою переменную: directory ( directory = strPath ), чтобы открыть рабочую книгу и скопировать ее содержимое в мою текущую рабочую книгу. Который отлично работает, если вы собираетесь использовать инструмент один раз. Ошибка возникает, когда вы импортируете один файл, затем другой, который находится в том же каталоге.

Нерабочий пример:

Выбран C:DesktopFile1.xls ,
Выбранный импорт C:DesktopFile2.xls , Импорт

Ошибка:

Ошибка времени выполнения ‘1004’:
документ с именем ‘Tool.xlsm’ уже открыт. Вы не можете открыть два документа с одинаковым именем, даже если документы находятся в разных папках. Чтобы открыть второй документ, либо закройте текущий открытый документ, либо переименуйте один из документов.

Рабочий пример (отдельные папки):

Выбран C:DesktopFile1.xls ,
Выбранный импорт C:DesktopTestFolderFile2.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 amp; "*.xls")


    Do While FileName <> ""
    Workbooks.Open (directory amp; 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 amp; 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 amp; FileName)
end if
on error goto 0
  

если вы не используете application.enableevents=false, ваш открытый Wb вызовет события workbook_open !

Я хотел опубликовать рабочий код, возможно, это поможет кому-то в будущем. Еще раз спасибо тем, кто оставил комментарии.

Этот код откроет диалоговое окно с файлом, позволит пользователю выбрать 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 amp; TextBox1)
End If
On Error GoTo 0       


    FileName = Dir(directory amp; TextBox1)    

    Do While FileName <> ""
    Workbooks.Open (directory amp; 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