user3596788
user3596788

Reputation: 95

VBA Opening workbook error

I have a VB form in Access 2010, that opens a file dialog box to make a excel selection. I send the file path as string to my variable: directory (directory = strPath) to open the workbook and copy its contents to my current workbook. Which works fine if you intend to use the tool once. It's when you import one file, then another that's in the same directory the error occurs.


Non-working Example:

Selected C:\Desktop\File1.xls, Import
Selected C:\Desktop\File2.xls, Import

Error:

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.


Working Example (Separate Folders):

Selected C:\Desktop\File1.xls, Import
Selected C:\Desktop\TestFolder\File2.xls, Import


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

In DEBUG mode it doesn't like

Workbooks.Open (directory & FileName)

Any suggestions on a way to eliminate this error?

Upvotes: 0

Views: 2988

Answers (2)

user3596788
user3596788

Reputation: 95

I wanted to post the working code, maybe it will help someone in the future. Thanks again to those who left comments.

This code will open a file dialog, allow the user to select 1 excel file then copy all sheets from the selected file into the current workbook.

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

Upvotes: 0

Patrick Lepelletier
Patrick Lepelletier

Reputation: 1652

First, between directory and FileName, i assume there is a "\".

secondly, simply check if the workbook is already opened:

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

if you don't use application.enableevents=false, your opened Wb will trigger its workbook_open events !

Upvotes: 1

Related Questions