Home |
Search |
Today's Posts |
#1
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
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 |
Thread Tools | Search this Thread |
Display Modes | |
|
|
![]() |
||||
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 |