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.
Thanks
roykana
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 Subroykana
