V
Vamsi Challa
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).ProtectContents =
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,
compare:=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
' 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).Copy 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
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).ProtectContents =
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,
compare:=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
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' 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).Copy 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