The below code is OLD, it is meant to import data that is greater than the number of rows on any given tab. It should open the file, chunk thru the import of data, and when hitting a defined row, create another tab and continue importing until doe.
Current execution of code is failing on this line: sFilename = Mid(sPathFileName, iBackslash + 1, iPoint - iBackslash - 1)
Code: Select all
Public Sub ImportMultSheets(sPathFileName As String)
Dim wks As Worksheet
Dim sFilename As String
Dim lRow As Long
Dim lLimit As Long
Dim sLine As String
Dim sArray() As String
Dim iSeq As Integer
Dim iPoint As Integer
Dim iBackslash As Integer
iPoint = InStrRev(sPathFileName, ".")
iBackslash = InStrRev(sPathFileName, "\")
sFilename = Mid(sPathFileName, iBackslash + 1, iPoint - iBackslash - 1)
lLimit = 1048570
ReDim sArray(1 To lLimit, 0)
lRow = 1
Open sPathFileName For Input As #1
Do While Not EOF(1)
Line Input #1, sLine
sArray(lRow, 0) = sLine
lRow = lRow + 1
If lRow = lLimit + 1 Then
Set wks = Worksheets.Add
iSeq = iSeq + 1
With wks
.Name = sFilename & iSeq
.Range("A1").Resize(lLimit, 1).Value = sArray
.Columns("a:a").TextToColumns _
Destination:=Range("A1"), _
DataType:=xlDelimited, Comma:=True
End With
ReDim sArray(1 To lLimit, 0)
lRow = 1
End If
Loop
Set wks = Worksheets.Add
iSeq = iSeq + 1
With wks
.Name = sFilename & iSeq
.Range("A1").Resize(lLimit, 1).Value = sArray
.Columns("a:a").TextToColumns _
Destination:=Range("A1"), _
DataType:=xlDelimited, Comma:=True
End With
Close #1
Set wks = Nothing
End Sub
Sub ImportMultFiles() 'this is incase I have multiple files to process....
ImportMultSheets "C:\Users\xxx\Downloads\xxx\Extract Files\TMP\Test Import\"
End Sub