Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
importing more than 65536 rows from .csv file
Hi
I am trying import a .csv file which contains more than 65536 rows. I created a macro to import and it is successfully importing with out a text qualitfier. can any one help me how to import huge .CSV files to one excel sheet? Thank you Vamsi Const C_START_ROW_FIRST_PAGE = 2 ' data starts on this row for all subsequent sheets Const C_START_ROW_LATER_PAGES = 2 ' worksheet name where data should start. This sheet must exist. Const C_START_SHEET_NAME = "Sheet1" ' what column do we start placing the data Const C_START_COLUMN = 2 ' newly created worksheets will be named C_SHEET_NAME_PREFIX & Format(SheetNum,"0") Const C_SHEET_NAME_PREFIX = "DataImport" ' newly created worksheets will be based on this template sheet. set to vbNullString if ' you don't want to use a template sheet and use a blank sheet instead. Const C_TEMPLATE_SHEET_NAME = vbNullString ' update the Application.StatusBar every C_UPDATE_STATUSBAR_EVERY_N_RECORDS records. ' set this to 0 if you don't want status bar messages. Const C_UPDATE_STATUSBAR_EVERY_N_RECORDS = 1000 ' this is the message to be displayed in the status bar. The number of records ' read so far will be appended to this value. Const C_STATUSBAR_TEXT = "Processing Record: " Dim RowNdx As Long ' Current RowNumber Dim Colndx As Long ' Current Column Dim FName As Variant ' Input file name Dim FNum As Integer ' Filenumber returned by FreeFile Dim WS As Worksheet ' Worksheet on which the data should be placed Dim InputLine As String ' The entire line of text read from the input file Dim Arr As Variant ' Used with Split to break InputLine into an array, ' delimited by SplitChart Dim SplitChar As String ' The character used by Split. This character delimits ' the input data fields in InputLine. Typically, this ' character will be a comma, semicolon, or vbTab. ' If this character is vbNullString, the input data ' won't be split, and the entire InputLine will be ' put in column C_START_COLUMN Dim SheetNumber As Long ' Increments for each worksheet we populate with data Dim SaveCalc As XlCalculation ' Caller's Calculation mode. Dim SaveScreenUpdating As Boolean ' Caller's ScreenUpdating mode Dim SaveDisplayAlerts As Boolean ' Caller's DisplayAlerts property Dim SaveEnableEvents As Boolean ' Caller's EnableEvents property Dim InputCounter As Long ' Counter of all records imported Dim LastRowForInput As Long ' Indicate the last row on the worksheet than ' input data should be used. Set this to a value <= Rows.Count. Dim MaxRowsPerSheet As Long ' The maximumn number of rows to import on each sheet. ' Set this to <= 0 if you don't want to use this parameter. Dim RowsThisSheet As Long ' Keeps track of the rows imported on to the current sheet. Dim TruncatedCount As Long ' Counts the number of records whose input was truncated because ' it would have gone past the last column of the worksheet. Dim strTemp As String SheetNumber = 1 ''''''''''''''''''''''''''''''''''''''''''''' ' Ensure we have an active workbook. ''''''''''''''''''''''''''''''''''''''''''''' If Application.ActiveWorkbook Is Nothing Then MsgBox "There is no active workbook." Exit Sub End If '''''''''''''''''''''''''''''''''''''''''''''' ' Set what character we're going to ' use to split apart the input line. The ' input line will be SPLIT on this character, ' and each text field will go into its own ' column. Data will be separated by ' SplitChar into multiple columns, starting ' on column C_START_COLUMN. If SplitChar is ' vbNullString, the entire input line is ' placed in C_START_COLUMN. SplitChar must ' be a single character. It is typically ' a comma, semicolon, or vbTab, but it can ' be any character. If SplitChar is set to ' more than one character, it is truncated ' to a single (the left-most) character. ' When placing data elements in separate ' columns, it is possible that the number of ' imported elements would extend past the ' last column of the worksheet. The count ' of records whose input was truncated because ' it would have gone past the last column ' of the worksheet is stored in the TruncatedCount ' variable. The value of this variable is ' displayed at the end of the procedure. ' '''''''''''''''''''''''''''''''''''''''''''''' SplitChar = "," '''''''''''''''''''''''''''''''''''''''''''''' ' Set the maximum number of data input rows ' to place on each worksheet. Set this ' value to <= 0 or to Rows.Count to fill ' the entire worksheet. '''''''''''''''''''''''''''''''''''''''''''''' MaxRowsPerSheet = 0& ''''''''''''''''''''''''''''''''''''''''''''' ' Set the LastRowForInput value. This when ' this row number is reached, a new worksheet ' will be created. Set this to 0 or ' WS.Rows.Count to fill the entire worksheet. ''''''''''''''''''''''''''''''''''''''''''''' LastRowForInput = ActiveWorkbook.Worksheets(1).Rows.Count '''''''''''''''''''''''''''''''''''''''''''''''''' ' Ensure that C_SHEET_NAME_PREFIX is <= 29 ' characters. This leaves us two characters for ' the numeric suffix, or 99 added sheets. If ' more sheets are needed, they will be created, ' and the data will be imported, but the sheets ' will have the default Excel-generated name, not ' the C_SHEET_NAME_PREFIX name. They will be in ' the correct order. '''''''''''''''''''''''''''''''''''''''''''''''''' If (Len(C_SHEET_NAME_PREFIX) < 1) Or (Len(C_SHEET_NAME_PREFIX) 29) Then MsgBox "The value of C_SHEET_NAME_PREFIX must have between 1 and 29 characters." & vbCrLf & _ "The current length of C_SHEET_NAME_PREFIX is " & CStr(Len(C_SHEET_NAME_PREFIX)) & " characters." Exit Sub End If '''''''''''''''''''''''''''''''''''''''''''''''''' ' ' Ensure C_START_SHEET_NAME refers to an existing ' sheet. '''''''''''''''''''''''''''''''''''''''''''''''''' ' On Error Resume Next Err.Clear Set WS = ActiveWorkbook.Worksheets(C_START_SHEET_NAME) If Err.Number < 0 Then MsgBox "The sheet named in C_START_SHEET_NAME (" & C_START_SHEET_NAME & ") does not exist" & vbCrLf & _ "or is not a worksheet (e.g., it is a chart sheet).", vbOKOnly Exit Sub End If '''''''''''''''''''''''''''''''''''''''''''''''''' ' Ensure that if C_TEMPLATE_SHEET_NAME is not ' vbNullString, it names an existing sheet, and ' that it is not equal to C_START_SHEET_NAME. '''''''''''''''''''''''''''''''''''''''''''''''''' On Error Resume Next Err.Clear If C_TEMPLATE_SHEET_NAME < vbNullString Then Set WS = ActiveWorkbook.Worksheets(C_TEMPLATE_SHEET_NAME) If Err.Number < 0 Then MsgBox "The template sheet '" & C_TEMPLATE_SHEET_NAME & "' does not exist or is not a worksheet." Exit Sub End If '''''''''''''''''''''''''''''''''''''''''''''''''' ' Ensure that C_START_SHEET_NAME does not equal ' C_TEMPLATE_SHEET_NAME '''''''''''''''''''''''''''''''''''''''''''''''''' If C_TEMPLATE_SHEET_NAME = C_START_SHEET_NAME Then MsgBox "The C_TEMPLATE_SHEET_NAME is equal to the C_START_SHEET_NAME." & vbCrLf & _ "This is not allowed." Exit Sub End If End If On Error GoTo 0 '''''''''''''''''''''''''''''''''''''''''''''''''' '' ' We may have changed the worksheet referenced by WS ' when testing if C_TEMPLATE_SHEET_NAME exists. Reset ' WS back to C_START_SHEET_NAME. '''''''''''''''''''''''''''''''''''''''''''''''''' '' Set WS = ActiveWorkbook.Worksheets(C_START_SHEET_NAME) '''''''''''''''''''''''''''''''''''''''''''''''''' ' Ensure that none of the following are protected: ' C_START_SHEET_NAME ' C_TEMPLATE_SHEET_NAME ' ActiveWorkbook '''''''''''''''''''''''''''''''''''''''''''''''''' If WS.ProtectContents = True Then MsgBox "The worksheet '" & WS.Name & "' is protected." Exit Sub End If If C_TEMPLATE_SHEET_NAME < vbNullString Then If ActiveWorkbook.Worksheets(C_TEMPLATE_SHEET_NAME).P rotectContents = True Then MsgBox "The Template Sheet (" & C_TEMPLATE_SHEET_NAME & ") is protected." Exit Sub End If End If If ActiveWorkbook.ProtectStructure = True Then MsgBox "The ActiveWorkbook is protected." Exit Sub End If '''''''''''''''''''''''''''''''''''''''''''''' ' Prompt the user for a TXT or CSV file '''''''''''''''''''''''''''''''''''''''''''''' FName = Application.GetOpenFilename(FileFilter:="Text Files (*.txt),*.txt," & _ "CSV Files (*.csv),*.csv") If FName = False Then ' user clicked CANCEL. get out now. Exit Sub End If '''''''''''''''''''''''''''''''''''''''''''''' ' Set our starting destination worksheet. ' Error and exit if sheet does not exist '''''''''''''''''''''''''''''''''''''''''''''' On Error Resume Next Set WS = ActiveWorkbook.Worksheets(C_START_SHEET_NAME) If WS Is Nothing Then MsgBox "The worksheet specified in C_START_SHEET_NAME (" & _ C_START_SHEET_NAME & ") does not exist." Exit Sub End If On Error GoTo 0 ''''''''''''''''''''''''''''''''''''''''''''' ' See if the file FName is open by another ' process. If it is, exit the procedure. ''''''''''''''''''''''''''''''''''''''''''''' If IsFileOpen(FileName:=CVar(FName)) = True Then MsgBox "The file '" & FName & "' is open by another process." Exit Sub End If '''''''''''''''''''''''''''''''''''''''''''''' ' Save the calculation mode and the ScreenUpdating ' mode. Set calculation to manual and turn off ' ScreenUpdating. This will greatly improve ' the performance of the code. '''''''''''''''''''''''''''''''''''''''''''''' SaveCalc = Application.Calculation SaveDisplayAlerts = Application.DisplayAlerts SaveScreenUpdating = Application.ScreenUpdating SaveEnableEvents = Application.EnableEvents Application.DisplayAlerts = False Application.Calculation = xlCalculationManual Application.ScreenUpdating = False Application.EnableEvents = False '''''''''''''''''''''''''''''''''''''''''''''' ' Get a file number and open the file '''''''''''''''''''''''''''''''''''''''''''''' On Error Resume Next FNum = FreeFile Err.Clear Open FName For Input Access Read As #FNum If Err.Number < 0 Then ''''''''''''''''''''''''''''''''''''''''' ' If an error occurred, alert the user, ' restore application settings, and ' exit the procedure. ''''''''''''''''''''''''''''''''''''''''' MsgBox "An error occurred opening file '" & FName & "'." & vbCrLf & _ "Error Number: " & CStr(Err.Number) & vbCrLf & _ "Description: " & Err.Description Close #FNum Application.Calculation = SaveCalc Application.ScreenUpdating = SaveScreenUpdating Application.DisplayAlerts = SaveDisplayAlerts Application.EnableEvents = SaveEnableEvents Exit Sub End If On Error GoTo 0 '''''''''''''''''''''''''''''''''''''''''''''' ' Initialize the RowNd index variable to ' C_START_ROW_FIRST_PAGE. This constant ' is used to preserve any header rows that ' may be present. '''''''''''''''''''''''''''''''''''''''''''''' RowNdx = C_START_ROW_FIRST_PAGE '''''''''''''''''''''''''''''''''''''''''''''' ' Ensure that SplitChar is a single character. '''''''''''''''''''''''''''''''''''''''''''''' If SplitChar < vbNullString Then SplitChar = Left(SplitChar, 1) End If '''''''''''''''''''''''''''''''''''''''''''''' ' If LastRowForInput is <= 0, then set it ' to Rows.Count '''''''''''''''''''''''''''''''''''''''''''''' If LastRowForInput <= 0 Then LastRowForInput = WS.Rows.Count End If '''''''''''''''''''''''''''''''''''''''' ' If MaxRowsPerSheet is <= 0, use Rows.Count '''''''''''''''''''''''''''''''''''''''' If MaxRowsPerSheet <= 0 Then MaxRowsPerSheet = Rows.Count End If '''''''''''''''''''''''''''''''''''''''''''''' ' Loop until we hit the end of the file. '''''''''''''''''''''''''''''''''''''''''''''' On Error GoTo 0 Do Until EOF(FNum) '''''''''''''''''''''''''''''''''''''''''''''' ' Get the next line of data from the file '''''''''''''''''''''''''''''''''''''''''''''' Line Input #FNum, InputLine '''''''''''''''''''''''''''''''''''''''''' ' Increment counters. '''''''''''''''''''''''''''''''''''''''''' InputCounter = InputCounter + 1 RowsThisSheet = RowsThisSheet + 1 '''''''''''''''''''''''''''''''''''''''''' ' Determine whether to update the StatusBar. '''''''''''''''''''''''''''''''''''''''''' If C_UPDATE_STATUSBAR_EVERY_N_RECORDS 0 Then If InputCounter Mod C_UPDATE_STATUSBAR_EVERY_N_RECORDS = 0 Then Application.StatusBar = C_STATUSBAR_TEXT & _ Format(InputCounter, "#,##0") End If End If If SplitChar = vbNullString Then '''''''''''''''''''''''''''''''''''''' ' We're not spliting up the input. Put ' the entire line in column C_START_COLUMN '''''''''''''''''''''''''''''''''''''' WS.Cells(RowNdx, C_START_COLUMN).Value = InputLine Else '''''''''''''''''''''''''''''''''''''''' ' SplitChar is not vbNullString. ' We're spliting up the input into columns. ' Use Split to get an array of the items ' in InputLine, delimited by SplitChar, ' and then loop through the Arr array, putting ' each element in its own column '''''''''''''''''''''''''''''''''''''''' Arr = Split(expression:=InputLine, delimiter:=SplitChar, limit:=-1, compa=vbTextCompare) For Colndx = LBound(Arr) To UBound(Arr) '''''''''''''''''''''''''''''''''''''''''''''''''' ''' ' Ensure we don't try to write past the last column ' of the worksheet. If we reach the last column, ' exit out of the For loop. '''''''''''''''''''''''''''''''''''''''''''''''''' ''' If Colndx + C_START_COLUMN <= WS.Columns.Count Then 'strTemp = Arr(Colndx) If Left(Arr(Colndx), 1) = Chr(34) Then strTemp = Mid(Arr(Colndx), 2, Len(Arr(Colndx)) - 2) Else strTemp = Arr(Colndx) End If WS.Cells(RowNdx, Colndx + C_START_COLUMN).Value = strTemp 'Arr(Colndx) Else TruncatedCount = TruncatedCount + 1 Exit For End If Next Colndx End If ' SplitChar = vbNullString ''''''''''''''''''''''''''''''''''''''' ' Increment the RowNdx index variable. ' If it is greater than either of the following: ' Rows.Count ' LastRowForInput ' or if RowsThisSheet is MaxRowsPerSheet ' then create and name a new worksheet and ' reset the RowNdx index variable to ' C_START_ROW_LATER_PAGES. '''''''''''''''''''''''''''''''''''''''' RowNdx = RowNdx + 1 If (RowNdx Rows.Count) Or (RowNdx LastRowForInput) Or (RowsThisSheet MaxRowsPerSheet) Then '''''''''''''''''''''''''''''''''''''''''''''''''' ''''''' ' We're past the end of the worksheet or past the row ' specified in LastRowForInput or the rows used on this ' worksheet is greater than MaxRowsPerSheet. ' ' Increment the SheetNumber index and either create a ' new sheet (if C_TEMPLATE_SHEET_NAME is vbNullString) or ' copy the C_TEMPLATE_SHEET_NAME worksheet ' immediately after the current sheet, and name it ' C_SHEET_NAME_PREFIX & Format(SheetNumber, "0") ' Reset the RowNdx value to C_START_ROW_LATER_PAGE '''''''''''''''''''''''''''''''''''''''''''''''''' ''''''' SheetNumber = SheetNumber + 1 If C_TEMPLATE_SHEET_NAME = vbNullString Then Set WS = ActiveWorkbook.Worksheets.Add(after:=WS) Else ActiveWorkbook.Worksheets(C_TEMPLATE_SHEET_NAME).C opy after:=WS Set WS = ActiveWorkbook.ActiveSheet End If On Error Resume Next '''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''' ' ignore the error that might arise if there is already a ' sheet named ' C_SHEET_NAME_PREFIX & Format(SheetNumber, "0") '''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''' WS.Name = C_SHEET_NAME_PREFIX & Format(SheetNumber, "0") On Error GoTo 0 '''''''''''''''''''''''''''''''''''''''''''''''''' ''''''' ' Reset out counters. '''''''''''''''''''''''''''''''''''''''''''''''''' ''''''' RowNdx = C_START_ROW_LATER_PAGES RowsThisSheet = 0 End If '''''''''''''''''''''''''''''''''''''''''''''' ' end of Read loop '''''''''''''''''''''''''''''''''''''''''''''' Loop '''''''''''''''''''''''''''''''''''''''''''''' ' Close the input file and restore the saved ' application settings. '''''''''''''''''''''''''''''''''''''''''''''' Close FNum Application.Calculation = SaveCalc Application.ScreenUpdating = SaveScreenUpdating Application.DisplayAlerts = SaveDisplayAlerts Application.EnableEvents = SaveEnableEvents Application.StatusBar = False '''''''''''''''''''''''''''''''''''''''''''''' ' MsgBox to the user indicating we're done. '''''''''''''''''''''''''''''''''''''''''''''' MsgBox "Import operation from file '" & FName & "' complete." & vbCrLf & _ "Records Imported: " & Format(InputCounter, "#,##0") & vbCrLf & _ "Records Truncated: " & Format(TruncatedCount, "#,##0"), _ vbOKOnly, "Import Text File" '''''''''''''''''''''' ' END OF PROCEDURE '''''''''''''''''''''' End Sub Private Function IsFileOpen(FileName As String) As Boolean '''''''''''''''''''''''''''''''''''''''''''''''''' '''''''''''''''''''''''''''''''''''''''''''''''''' '''' ' IsFileOpen ' This function determines whether a file is open by any program. Returns TRUE or FALSE. '''''''''''''''''''''''''''''''''''''''''''''''''' '''''''''''''''''''''''''''''''''''''''''''''''''' '''' Dim FileNum As Integer Dim ErrNum As Long Const C_ERR_NO_ERROR = 0& Const C_ERR_PERMISSION_DENIED = 70& On Error Resume Next '''''''''''''''''''''''''''''''''''''''''''''''''' '''''''''''''''''''''''''''''' ' If we were passed in an empty string, there is no file to test so return False. '''''''''''''''''''''''''''''''''''''''''''''''''' '''''''''''''''''''''''''''''' If FileName = vbNullString Then IsFileOpen = False Exit Function End If '''''''''''''''''''''''''''''''''''''''''''''''''' '''''''''''''''''''''''''''''' ' If the file doesn't exist, it certainly isn't open. This test will also ' take care of the case of a syntactically invalid file name. A syntactically ' invalid file name will raise an error 52, but Dir will return vbNullString. ' It is up to the calling procedure to ensure that the filename is syntactically ' valid. '''''''''''''''''''''''''''''''''''''''''''''''''' '''''''''''''''''''''''''''''' On Error Resume Next If Dir(FileName, vbNormal + vbArchive + vbSystem + vbHidden) = vbNullString Then IsFileOpen = False Exit Function End If FileNum = FreeFile() ' Get a free file number. '''''''''''''''''''''''''''''''''''''''''''' ' Attempt to open the file and lock it. '''''''''''''''''''''''''''''''''''''''''''' Err.Clear Open FileName For Input Lock Read As #FileNum '''''''''''''''''''''''''''''''''''''''''''' ' Save the error number, since it will get ' reset by the Close operation. '''''''''''''''''''''''''''''''''''''''''''' ErrNum = Err.Number Close FileNum '''''''''''''''''''''''''''''''''''' ' Check to see which error occurred. '''''''''''''''''''''''''''''''''''' Select Case ErrNum Case C_ERR_NO_ERROR ''''''''''''''''''''''''''''''''' ' No error. The file is not open. ''''''''''''''''''''''''''''''''' IsFileOpen = False Case C_ERR_PERMISSION_DENIED ''''''''''''''''''''''''''''''''' ' Permission denied. The file is ' open. ''''''''''''''''''''''''''''''''' IsFileOpen = True Case Else ''''''''''''''''''''''''''''''''' ' We should never get here, but ' if we do, return True to be safe. ''''''''''''''''''''''''''''''''' IsFileOpen = True End Select End Function |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
importing more than 65536 rows from .csv file
On 23 Jan, 00:15, Vamsi Challa <Vamsi
wrote: Hi I am trying import a .csvfilewhich contains more than 65536 rows. I created a macro to import and it is successfully importing with out a text qualitfier. can any one help me how to import huge .CSVfiles to one excel sheet? If you are importing many records, using ADO and CopyFromRecordset will be far quicker than using Line Input# and Split. Could you give a sample of the first few lines of the csv file? |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Importing File greater than 65536 | Excel Programming | |||
Importing File greater than 65536 | Excel Worksheet Functions | |||
how do I import a CSV file with more than 65536 rows | Excel Programming | |||
Importing Text File with more than 65536 rows | Excel Programming | |||
Importing a large text file (65536) | Excel Programming |