Assistance with OLD Import code

bradjedis
4StarLounger
Posts: 471
Joined: 30 Mar 2010, 18:49
Location: United States

Assistance with OLD Import code

Post by bradjedis »

Greetings,

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
any ideas? better solution?

User avatar
HansV
Administrator
Posts: 74382
Joined: 16 Jan 2010, 00:14
Status: Microsoft MVP
Location: Wageningen, The Netherlands

Re: Assistance with OLD Import code

Post by HansV »

The procedure ImportMultSheets is intended to process one file only. It cannot process multiple files.
See if it works if you change ImportMultFiles to

Code: Select all

Sub ImportMultFiles()  'this is incase I have multiple files to process....
  Dim sFolder As String
  Dim sFile As String
  sFolder = "C:\Users\xxx\Downloads\xxx\Extract Files\TMP\Test Import\"
  sFile = Dir(sFolder & "*.xls*")
  Do While sFile <> ""
    ImportMultSheets sFolder & sFile
    sFile = Dir
  Loop
End Sub
Regards,
Hans

bradjedis
4StarLounger
Posts: 471
Joined: 30 Mar 2010, 18:49
Location: United States

Re: Assistance with OLD Import code

Post by bradjedis »

Well, I have had this one running for several hours... Not completing. Not sure if the Code is bad, or If I just do not have enough horsepower on my machine, or enough memory. Trying to import 2.7 mil lines.

User avatar
HansV
Administrator
Posts: 74382
Joined: 16 Jan 2010, 00:14
Status: Microsoft MVP
Location: Wageningen, The Netherlands

Re: Assistance with OLD Import code

Post by HansV »

Does your keyboard have a Pause or Break key? If so try pressing Ctrl+Pause/Break to see if this interrupts code execution. You can then hover the mouse pointer over variables such as sFilename, and/or end code execution.
Regards,
Hans

bradjedis
4StarLounger
Posts: 471
Joined: 30 Mar 2010, 18:49
Location: United States

Re: Assistance with OLD Import code

Post by bradjedis »

Yes, I do have that key. I will give it a go...