Import multi dat files in vba run-time error 13

R

roykana

Active Member
Joined
Mar 8, 2018
Messages
311
Office Version
  1. 2010
Platform
  1. Windows
Dear All Master,
I want to import multi dat files but there is a "run-time error of 13" and I mark the color red in the code below. Please solution.

VBA Code: 
Option Explicit


Sub Get_Data_From_File()
    OptimizeVBA True
    Dim FileToOpen As Variant
    Dim OpenBook As Workbook
    Dim k As Long
    Dim L As Long
    Dim J As Long
    Dim LastRow As Long
    Dim LastColumn As Long
    Dim objTable As ListObject
    Dim objTable2 As String
    Dim startTime As Single, endTime As Single
    startTime = Timer
    
    Application.ScreenUpdating = False
     With Application
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
        .EnableEvents = False
    End With
    ActiveSheet.DisplayPageBreaks = False
 
   Range("A1").CurrentRegion.Clear
  
    FileToOpen = Application.GetOpenFilename(Title:="Browse for your File & Import Range", FileFilter:="Dat Files (*.dat*),*dat*", MultiSelect:=True)
[COLOR=rgb(184, 49, 47)]If FileToOpen <> False Then 'this line run-time error 13[/COLOR]
        Set OpenBook = Application.Workbooks.Open(FileToOpen)
        OpenBook.Sheets(1).Range(Cells(1, 1), Cells(1, 2).End(xlDown)).Copy
        ThisWorkbook.Worksheets("selectfile").Range("A2:B2").PasteSpecial xlPasteValues
        OpenBook.Close False
Range("A1").CurrentRegion.Select
   Set objTable = ActiveSheet.ListObjects.Add(xlSrcRange, Selection, , xlYes)
   
   End If
 On Error GoTo getout 'if A1 doesn't belong to any Excel Table, then code will end execution
   If [A1].ListObject <> "" Then
    On Error GoTo 0 'restart Error handler
    objTable2 = [A1].ListObject.Name
   End If
  Application.ScreenUpdating = False
 Application.CutCopyMode = False: [H2].Select
getout:
    Application.ScreenUpdating = True
    With Application
        .EnableEvents = True
        .Calculation = xlCalculationAutomatic
        .ScreenUpdating = True
    End With


    endTime = Timer
    Debug.Print (endTime - startTime) & " seconds have passed [VBA]"
    OptimizeVBA False
End Sub
Sub OptimizeVBA(isOn As Boolean)
    Application.Calculation = IIf(isOn, xlCalculationManual, xlCalculationAutomatic)
    Application.EnableEvents = Not (isOn)
    Application.ScreenUpdating = Not (isOn)
    ActiveSheet.DisplayPageBreaks = Not (isOn)

End Sub
Thanks
roykana
 

Excel Facts

Convert text numbers to real numbers
Select a column containing text numbers. Press Alt+D E F to quickly convert text to numbers. Faster than "Convert to Number"
Sort by date Sort by votes
I believe the error is caused by MultiSelect:=True. If you select multiple files, then you can only open only one file at a time. Therefore, you need to loop through each file. FileToOpen will become an array list of file to open. You need to loop through each file to open and execute the task.

Have you ever tried to disable this MultiSelect:=False, and check if the code works? If that is okay, then it is the problem above.
 
Upvote 0
Zot said:
I believe the error is caused by MultiSelect:=True. If you select multiple files, then you can only open only one file at a time. Therefore, you need to loop through each file. FileToOpen will become an array list of file to open. You need to loop through each file to open and execute the task.

Have you ever tried to disable this MultiSelect:=False, and check if the code works? If that is okay, then it is the problem above.
Click to expand...
If I change the code below:
VBA Code: 
MultiSelect:=True
'become 
MultiSelect:=False
I have changed the code there is no error but I can not import multi file dat
 
Upvote 0
As I said if you select multiple files you will have an array of file names. So, the Set OpenBook cannot know which one to open.

I made some modification on your code (I hope I understood the flow :)) but I did not test it. You will get the idea what the code was trying to do

VBA Code: 
Sub Get_Data_From_File()
    OptimizeVBA True
    Dim FileToOpen As Variant
    Dim OpenBook As Workbook
    Dim i As Long
    Dim k As Long
    Dim L As Long
    Dim J As Long
    Dim LastRow As Long
    Dim LastColumn As Long
    Dim objTable As ListObject
    Dim objTable2 As String
    Dim startTime As Single, endTime As Single
    startTime = Timer
    
    Application.ScreenUpdating = False
     With Application
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
        .EnableEvents = False
    End With
    ActiveSheet.DisplayPageBreaks = False
 
   Range("A1").CurrentRegion.Clear
  
    FileToOpen = Application.GetOpenFilename(Title:="Browse for your File & Import Range", FileFilter:="Dat Files (*.dat*),*dat*", MultiSelect:=True)
    
    On Error Resume Next
    If IsArray(FileToOpen) Then
        On Error GoTo 0
        For i = LBound(FileToOpen) To UBound(FileToOpen)
            Set OpenBook = Application.Workbooks.Open(FileToOpen(i))
            OpenBook.Sheets(1).Range(Cells(1, 1), Cells(1, 2).End(xlDown)).Copy
            ThisWorkbook.Worksheets("selectfile").Range("A2:B2").PasteSpecial xlPasteValues
            OpenBook.Close False
            Range("A1").CurrentRegion.Select
            Set objTable = ActiveSheet.ListObjects.Add(xlSrcRange, Selection, , xlYes)
   
            If [A1].ListObject <> "" Then
                objTable2 = [A1].ListObject.Name
            End If
            Application.ScreenUpdating = False
            Application.CutCopyMode = False: [H2].Select
        Next
    Else
        If FileToOpen = False Then
            On Error GoTo 0
            GoTo getout
        End If
    End If
getout:
    Application.ScreenUpdating = True
    With Application
        .EnableEvents = True
        .Calculation = xlCalculationAutomatic
        .ScreenUpdating = True
    End With

    endTime = Timer
    Debug.Print (endTime - startTime) & " seconds have passed [VBA]"
    OptimizeVBA False
End Sub
Sub OptimizeVBA(isOn As Boolean)
    Application.Calculation = IIf(isOn, xlCalculationManual, xlCalculationAutomatic)
    Application.EnableEvents = Not (isOn)
    Application.ScreenUpdating = Not (isOn)
    ActiveSheet.DisplayPageBreaks = Not (isOn)

End Sub
 
Upvote 0
Zot said:
As I said if you select multiple files you will have an array of file names. So, the Set OpenBook cannot know which one to open.

I made some modification on your code (I hope I understood the flow :)) but I did not test it. You will get the idea what the code was trying to do

VBA Code: 
Sub Get_Data_From_File()
    OptimizeVBA True
    Dim FileToOpen As Variant
    Dim OpenBook As Workbook
    Dim i As Long
    Dim k As Long
    Dim L As Long
    Dim J As Long
    Dim LastRow As Long
    Dim LastColumn As Long
    Dim objTable As ListObject
    Dim objTable2 As String
    Dim startTime As Single, endTime As Single
    startTime = Timer
   
    Application.ScreenUpdating = False
     With Application
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
        .EnableEvents = False
    End With
    ActiveSheet.DisplayPageBreaks = False
 
   Range("A1").CurrentRegion.Clear
 
    FileToOpen = Application.GetOpenFilename(Title:="Browse for your File & Import Range", FileFilter:="Dat Files (*.dat*),*dat*", MultiSelect:=True)
   
    On Error Resume Next
    If IsArray(FileToOpen) Then
        On Error GoTo 0
        For i = LBound(FileToOpen) To UBound(FileToOpen)
            Set OpenBook = Application.Workbooks.Open(FileToOpen(i))
            OpenBook.Sheets(1).Range(Cells(1, 1), Cells(1, 2).End(xlDown)).Copy
            ThisWorkbook.Worksheets("selectfile").Range("A2:B2").PasteSpecial xlPasteValues
            OpenBook.Close False
            Range("A1").CurrentRegion.Select
            Set objTable = ActiveSheet.ListObjects.Add(xlSrcRange, Selection, , xlYes)
  
            If [A1].ListObject <> "" Then
                objTable2 = [A1].ListObject.Name
            End If
            Application.ScreenUpdating = False
            Application.CutCopyMode = False: [H2].Select
        Next
    Else
        If FileToOpen = False Then
            On Error GoTo 0
            GoTo getout
        End If
    End If
getout:
    Application.ScreenUpdating = True
    With Application
        .EnableEvents = True
        .Calculation = xlCalculationAutomatic
        .ScreenUpdating = True
    End With

    endTime = Timer
    Debug.Print (endTime - startTime) & " seconds have passed [VBA]"
    OptimizeVBA False
End Sub
Sub OptimizeVBA(isOn As Boolean)
    Application.Calculation = IIf(isOn, xlCalculationManual, xlCalculationAutomatic)
    Application.EnableEvents = Not (isOn)
    Application.ScreenUpdating = Not (isOn)
    ActiveSheet.DisplayPageBreaks = Not (isOn)

End Sub
Click to expand...
@Zot
Dear Mr.Zot
Thanks for your reply. to select multi file dat no error but imported data goes into excel sheet only one file dat.
Thanks
Roykana
 
Upvote 0
I have no idea what you were trying to do but this part is opening file one after another
Rich (BB code): 
For i = LBound(FileToOpen) To UBound(FileToOpen)
            Set OpenBook = Application.Workbooks.Open(FileToOpen(i))
            OpenBook.Sheets(1).Range(Cells(1, 1), Cells(1, 2).End(xlDown)).Copy
            ThisWorkbook.Worksheets("selectfile").Range("A2:B2").PasteSpecial xlPasteValues
            OpenBook.Close False
            Range("A1").CurrentRegion.Select
            Set objTable = ActiveSheet.ListObjects.Add(xlSrcRange, Selection, , xlYes)
   
            If [A1].ListObject <> "" Then
                objTable2 = [A1].ListObject.Name
            End If
            Application.ScreenUpdating = False
            Application.CutCopyMode = False: [H2].Select
        Next

It open the dat file, copy and paste into workbook selectfile. Then close the dat. You then set objTable

After that open the 2nd dat file on the list and copy paste to same workbook same location. I have no idea what you were trying to achieve but at the end I think you will; see the content of last dat file.
 
Upvote 0
Zot said:
I have no idea what you were trying to do but this part is opening file one after another
Rich (BB code): 
For i = LBound(FileToOpen) To UBound(FileToOpen)
            Set OpenBook = Application.Workbooks.Open(FileToOpen(i))
            OpenBook.Sheets(1).Range(Cells(1, 1), Cells(1, 2).End(xlDown)).Copy
            ThisWorkbook.Worksheets("selectfile").Range("A2:B2").PasteSpecial xlPasteValues
            OpenBook.Close False
            Range("A1").CurrentRegion.Select
            Set objTable = ActiveSheet.ListObjects.Add(xlSrcRange, Selection, , xlYes)
  
            If [A1].ListObject <> "" Then
                objTable2 = [A1].ListObject.Name
            End If
            Application.ScreenUpdating = False
            Application.CutCopyMode = False: [H2].Select
        Next

It open the dat file, copy and paste into workbook selectfile. Then close the dat. You then set objTable

After that open the 2nd dat file on the list and copy paste to same workbook same location. I have no idea what you were trying to achieve but at the end I think you will; see the content of last dat file.
Click to expand...
@Zot
Dear Mr. Zot,
Thanks for your reply.
I've shared a sample file dat
link sample file dat
and also I have an error "run time error 1004"
VBA Code: 
Set objTable = ActiveSheet.ListObjects.Add(xlSrcRange, Selection, , xlYes) ' run time error 1004 A table cannot overlap another table

thanks
roykana
 
Upvote 0
I was trying to show how you can open file one by one through looping since you wanted to select multiple file. The error was caused because the code is copying the each dat file and paste it on same sheet same location each time.

I guess you were trying to keep adding data to objTable, right?
 
Upvote 0
Zot said:
I was trying to show how you can open file one by one through looping since you wanted to select multiple file. The error was caused because the code is copying the each dat file and paste it on same sheet same location each time.

I guess you were trying to keep adding data to objTable, right?
Click to expand...
@Zot
Dear Mr. Zot,
Thanks for your reply.
yes that's right, so all dat files become 1 table and one excel sheet
thanks
roykana
 
Upvote 0
I made some re-arrangement to your code and also add a function. It could be better but as of now I tested this to be working. I hope it is to your requirement. I rarely work with table ?
VBA Code: 
Sub Get_Data_From_File()
    OptimizeVBA True
    Dim FileToOpen As Variant
    Dim OpenBook As Workbook
    Dim wsSelect As Worksheet
    Dim i As Long
    Dim k As Long
    Dim L As Long
    Dim J As Long
    Dim LastRow As Long
    Dim LastColumn As Long
    Dim objTable As ListObject
    Dim objTable2 As String
    Dim startTime As Single, endTime As Single
    Dim TableFound As Boolean
    startTime = Timer
    
    Application.ScreenUpdating = False
    With Application
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
        .EnableEvents = False
    End With
    ActiveSheet.DisplayPageBreaks = False
    
    Set wsSelect = ActiveWorkbook.Sheets("selectfile")
  
    FileToOpen = Application.GetOpenFilename(Title:="Browse for your File & Import Range", FileFilter:="Dat Files (*.dat*),*dat*", MultiSelect:=True)
    On Error Resume Next
    If IsArray(FileToOpen) Then
        On Error GoTo 0
        For i = LBound(FileToOpen) To UBound(FileToOpen)
            Set OpenBook = Application.Workbooks.Open(FileToOpen(i))
            OpenBook.Sheets(1).Range(Cells(1, 1), Cells(1, 2).End(xlDown)).Copy
            TableFound = TableExists(wsSelect, "TableDat")
            If Not TableFound Then
                wsSelect.Range("A2:B2").PasteSpecial xlPasteValues
                OpenBook.Close False
                Set objTable = wsSelect.ListObjects.Add(xlSrcRange, Selection, , xlYes)
                objTable.Name = "TableDat"
            Else
                wsSelect.Cells(Rows.Count, "A").End(xlUp).Offset(1).PasteSpecial xlPasteValues
                OpenBook.Close False
            End If
        Next
    Else
        If FileToOpen = False Then
            On Error GoTo 0
            GoTo getout
        End If
    End If
getout:
    Application.ScreenUpdating = True
    With Application
        .EnableEvents = True
        .Calculation = xlCalculationAutomatic
        .ScreenUpdating = True
    End With
    Application.Goto wsSelect.Range("A1")
    endTime = Timer
    Debug.Print (endTime - startTime) & " seconds have passed [VBA]"
    OptimizeVBA False
End Sub
Sub OptimizeVBA(isOn As Boolean)
    Application.Calculation = IIf(isOn, xlCalculationManual, xlCalculationAutomatic)
    Application.EnableEvents = Not (isOn)
    Application.ScreenUpdating = Not (isOn)
    ActiveSheet.DisplayPageBreaks = Not (isOn)

End Sub

Function TableExists(ws As Worksheet, sTableName As String) As Boolean
    TableExists = ws.Evaluate("ISREF(" & sTableName & ")")
End Function
 
Upvote 0
You must log in or register to reply here.

Similar threads

T
  • Solved
Import Data Starting from next empty row
Replies
7
Views
473
Tanne
T
C
  • Solved
User Select PDF import to specific Excel sheet
2 3 4
Replies
31
Views
1K
John_w
J
R
  • Solved
want code import dat convert to vba array
2 3 4
Replies
35
Views
4K
roykana
R
SandsB
  • Question Question
Why does "Step Into" stop after I open my input file?
Replies
4
Views
503
SandsB
SandsB
M
  • Question Question
Power Query with Dynamic Data Source
Replies
4
Views
933
Alex Blakenburg
A

Forum statistics

Threads
1,223,896
Messages
6,175,263
Members
452,627
Latest member
KitkatToby

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top