Import data from a large text file to multiple worksheets (ADO)
2004-12-17 ADO 0 253
The procedure below can be used to create a dummy text file containing 1 000 000 semi-colon separated records:
Sub CreateTextFileDB() Dim strTextFile As String, f As Integer Dim strItem1 As String, strItem2 As String Dim i As Long, j As Long strTextFile = "C:\Temp" & Format(Date, "yyyymmdd") & ".txt" On Error Resume Next Kill strTextFile On Error GoTo 0 f = FreeFile Open strTextFile For Append As #f Print #f, "ITEM1;ITEM2;VALUEi;VALUEj;PRODUCT" For i = 1 To 100 strItem1 = "ITEM" & Format(i, "000") Application.StatusBar = "Writing data for " & strItem1 & "..." For j = 1 To 10000 strItem2 = "item" & Format(j, "00000") Print #f, strItem1 & ";" & strItem2 & ";" & i & ";" & j & ";" & i * j Next j DoEvents Next i Close #f Application.StatusBar = False End SubThe procedure below can be used to read input from a text file (such as the dummy file created by the procedure above), and put the records for each unique item in a field/column into a separate worksheet:
Sub CreateNewWorkbookFromTextFile(strFolder As String, strTextFile As String) ' use like this: CreateNewWorkbookFromTextFile "C:\Temp", "TextFileName.txt" Dim cn As ADODB.Connection, rs As ADODB.Recordset, rsItems As ADODB.Recordset Dim wb As Workbook, ws As Worksheet, i As Long, f As Long, strSQL As String If Len(strFolder) = 0 Then Exit Sub If Len(strTextFile) = 0 Then Exit Sub Set cn = New ADODB.Connection On Error Resume Next cn.Open "Driver={Microsoft Text Driver (*.txt; *.csv)};" & _ "Dbq=" & strFolder & ";" & _ "Extensions=asc,csv,tab,txt;" On Error GoTo 0 If cn.State <> adStateOpen Then Exit Sub ' get all unique items from one field Set rsItems = New ADODB.Recordset strSQL = "select distinct ITEM1 from " & strTextFile On Error Resume Next rsItems.Open strSQL, cn, adOpenForwardOnly, adLockReadOnly, adCmdText On Error GoTo 0 If rsItems.State <> adStateOpen Then ' did not find anything Set rsItems = Nothing cn.Close Set cn = Nothing Exit Sub End If Application.ScreenUpdating = False ' create a new workbook Set wb = Workbooks.Add i = 0 Do While Not rsItems.EOF ' for each unique field item Application.StatusBar = "Reading data for " & rsItems(0).Value & "..." i = i + 1 strSQL = "select * from " & strTextFile & " where ITEM1 = '" & rsItems(0).Value & "'" Set rs = New ADODB.Recordset On Error Resume Next rs.Open strSQL, cn, adOpenForwardOnly, adLockReadOnly, adCmdText On Error GoTo 0 If rs.State = adStateOpen Then Application.StatusBar = "Writing data for " & rsItems(0).Value & "..." With wb If i > .Worksheets.Count Then ' add a new worksheet .Worksheets.Add After:=.Worksheets(.Worksheets.Count) End If With .Worksheets(i) ' populate the item worksheet ' write field headings For f = 0 To rs.Fields.Count - 1 .Range("A1").Offset(0, f).Formula = rs.Fields(f).Name Next f .Rows(1).Font.Bold = True ' write data records .Range("A2").CopyFromRecordset rs, .Rows.Count - 1, Columns.Count .Columns("A:IV").AutoFit End With End With rs.Close End If Set rs = Nothing rsItems.MoveNext Application.StatusBar = False DoEvents Loop rsItems.Close Set rsItems = Nothing cn.Close Set cn = Nothing wb.Worksheets(1).Activate Set wb = Nothing Application.ScreenUpdating = True End SubIf you use the procedure above to create a dummy text file with 1 000 000 records, you can create a workbook with 100 worksheets containing 10 000 records each like this:
Sub TestCreateNewWorkbookFromTextFile() CreateNewWorkbookFromTextFile "C:\Temp", Format(Date, "yyyymmdd") & ".txt" End SubThe macro examples assumes that your VBA project has added a reference to the ADO object library. You can do this from within the VBE by selecting the menu Tools, References... and selecting the Microsoft ActiveX Data Objects x.x Object Library.
See information about using a Schema.ini file to set information about e.g. column data types and separator characters.