VBA 열기 통합 문서 오류

Question

Access 2010에서 VB 양식을 사용하여 파일 대화 상자를 열어 Excel을 선택합니다. 파일 경로를 내 변수 : directory (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, 가져 오기

DEBUG 모드에서

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 사이에 "\"이 있다고 가정합니다.

둘째, 단순히 통합 문서가 이미 열려 있는지 확인 : 당신이 application.enableevents를 사용하지 않는 경우

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 

는 = 거짓, 당신의 열 십억원는 workbook_open 이벤트를 트리거합니다!

Answer 2

작업 코드를 게시하고 싶습니다. 나중에 누군가에게 도움이 될 수 있습니다. 의견을 남긴 사람들에게 다시 한번 감사드립니다.

이 코드는 파일 대화 상자를 열어 사용자가 1 엑셀 파일을 선택한 다음 선택한 파일의 모든 시트를 현재 통합 문서로 복사 할 수 있도록합니다.

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