S
SanCarlosCyclist
Can someone help a non-technie with the steps of how to run VB code in
excel. On this site, lots of you post code some nifty tricks that I
would love to be able to do, but I do not know visual basic. I would
appreciate it if some one can walk me step by step through the process
of loading the code, changing the code, creating the macro to run the
code, and running the code. Below is an example of code I saw on this
site that I would love to be able to run. Your help is appreciated.
=======================================================================
Attribute VB_Name = "modImportBigFilesFunction"
Option Explicit
Option Compare Text
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' modImportBigFilesFunction
' By Chip Pearson, (e-mail address removed) www.cpearson.com
' This function requires Excel 2000 or later.
'
' Complete documentation and usage considerations are provided in the
comments that follow
' the procedure declaration. This module also includes the Private
procedure IsFileOpen which
' determines whether a file is open by another process.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Error Number Constants
' All error number constants begin with "C_ERR_IMPORT_".
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Const C_ERR_IMPORT_NO_ERROR = 0&
Public Const C_ERR_IMPORT_FILENAME_IS_BLANK = 1&
Public Const C_ERR_IMPORT_FILE_DOES_NOT_EXIST = 2&
Public Const C_ERR_IMPORT_START_SHEET_DOES_NOT_EXIST = 3&
Public Const
C_ERR_IMPORT_LASTROWFORINPUT_IS_GREATER_THAN_NUMBER_OF_ROWS = 4&
Public Const C_ERR_IMPORT_FILE_IS_OPEN = 5&
Public Const C_ERR_IMPORT_SHEETNAMEPREFIX_IS_EMPTY = 6&
Public Const C_ERR_IMPORT_STARTROWFIRSTPAGE_LESS_THAN_ZERO = 7&
Public Const
C_ERR_IMPORT_STARTROWFIRSTPAGE_IS_GREATER_THAN_NUMBER_OF_ROWS = 8&
Public Const C_ERR_IMPORT_STARTROWLATERPAGES_LESS_THAN_EQUAL_TO_ZERO =
9&
Public Const
C_ERR_IMPORT_STARATROWLATERPAGES_GREATER_THAN_NUMBER_OF_ROWS = 10&
Public Const C_ERR_IMPORT_START_COLUMN_IS_LESS_THAN_EQUAL_ZERO = 11&
Public Const C_ERR_IMPORT_START_COLUMN_GREATER_THAN_NUM_COLUMNS = 12&
Public Const C_ERR_IMPORT_ERROR_OPENING_FILE = 13&
Public Const C_ERR_IMPORT_MAXROWSPERSHEET_GREATER_THAN_NUMBER_OF_ROWS
= 14&
Public Const C_ERR_IMPORT_NO_ACTIVEWORKBOOK = 15&
Public Const C_ERR_IMPORT_PROTECTION_ERROR = 16&
Public Const C_ERR_IMPORT_SHEET_PREFIX_TOO_LONG = 17&
Public Const C_ERR_IMPORT_TEMPLATE_SHEET_DOES_NOT_EXIST = 18&
Public Const C_ERR_IMPORT_TEMPLATE_SHEET_IS_START_SHEET = 19&
Public Const C_ERR_IMPORT_START_SHEET_IS_NOT_WORKSHEET = 20&
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' F_ImportBigTextFile
' This function imports a text or CSV file into an Excel workbook. It
can
' handle any number of records, and will create additional worksheets
as
' needed. Full documentation follows the function declaration.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Function F_ImportBigTextFile(FileName As String, _
ByVal SplitChar As String, _
SheetNamePrefix As String, _
TemplateSheetName As String, _
StartRowFirstPage As Long, _
StartRowLaterPages As Long, _
StartSheetName As String, _
StartColumn As Long, _
UpdateStatusBarEveryNRecords As
Long, _
StatusBarText As String, _
LastRowForInput As Long, _
MaxRowsPerSheet As Long, _
ByRef TruncatedRecordsCount As
Long, _
ByRef ErrorNumber As Long, _
ByRef ErrorMessage As String) As
Long
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' F_ImportBigTextFile
' By Chip Pearson, (e-mail address removed), www.cpearson.com
' This procedure is on http://www.cpearson.com/excel/ImportBigFiles.htm
' This function requires Excel 2000 or later.
'
' An Excel worksheet (2003 and earlier) is limited to 65,536 rows. You
cannot increase this
' limit. Therefore, if you try to use Excel's tools ("Import External
Data") to import a text
' or csv file with more than 65,536 rows of data, Excel will only
import the first 65,536 records. This procedure
' may be used to import a text file of any number of rows. It will
begin the import by placing
' the imported data on the sheet named in C_START_SHEET_NAME starting
in row StartRowFirstPage.
'
' Note that the import process always writes records to the
ActiveWorkbook, which may or may not
' be the same workbook that contains this code. Ensure that the proper
workbook is active
' prior to running the import process.
'
' When any one or more of the following are true:
'
' RowNdx > Rows.Count
' RowNdx > LastRowForInput
' RowsThisSheet > MaxRowsPerSheet
'
' the procedure will create a new worksheet immediately following the
current worksheet, and
' name it
' SheetNamePrefix & Format(SheetNumber, "0")
'
' The procedure will optionally split the input into multiple columns,
delimited by a characer.
' The following procedure parameters determine how the procedure
handles data and new worksheets:
'
' FileName is the name of the file to import.
'
' SplitChar is the character which delimits the
data fields in the input data.
' If this character is vbNullString, the
entire input line of data
' will be placed in StartColumn. If
SplitChar is not vbNullString,
' it is truncated to 1 character and
then used in the Split function
' to split the input data into an array.
' Each element of the array is put into
its own column. SplitChar
' is typically set to a comma,
semicolon, or vbTab, but it may be any
' character. It is possible that
splitting the data across columns may
' result in data loss.
' If the number of data fields +
StartColumn is greater than the number
' of columns in the worksheet (256), the
right most data element(s) will
' not be imported. The number of
trucated records is returned to
' the TruncatedRecordsCount variable.
'
' SheetNamePrefix is the name used to create new
worksheets. A numeric
' sequence number will be appended to
this value to
' create the sheet name.
'
' TemplateSheetName is the name of an existing worksheet
that will be used
' as the template sheet for all
subsequent worksheets created
' by the procedure. This may NOT be the
same as StartSheetName.
' If you don't want to use a template
sheet, set this parameter
' to vbNullString.
'
' StartRowFirstPage is the row number on the first
worksheet (C_START_SHEET_NAME)
' where the data should be placed. This
is used if you have
' header rows that you don't want to
over write.
'
' StartRowLaterPages is the row number on subsequent (sheet
2, 3, etc) that the
' data should be placed.
'
' StartSheetName is the name of an existing worksheet.
The imported data will
' start by filling this sheet before
creating a new worksheet.
' This may NOT be the same as
TemplateSheetName.
'
' StartColumn is the column in which the data is
placed. If SplitChar is
' vbNullString, the entire line of input
data will be placed
' in this column. If SplitChar is not
vbNullString, the input
' data is split into an array using
SplitChar as a delimiter,
' and each data element will be put in
its own column, starting
' with StartColumn.
'
' UpdateStatusBarEveryNSeconds
' is the number of records after which
the a message will
' be displayed in the StatusBar. Set
this value to <= 0 if you
' do not want any StatusBar updates.
'
' StatusBarText is the text to be displayed in the
StatusBar. The current
' count will be appended to this text.
This value is not used
' if UpdateStatusBarEveryNSeconds is <=
0.
'
'
' LastRowForInput is the last row number on a worksheet
that the imported data
' should be placed. Set this to either
<= 0 or to Rows.Count
' to import data to the last row of the
worksheet.
'
' MaxRowsPerSheet is the maximum number of rows to
import on to a single worksheet.
' Set this to <= 0 or Rows.Count to
import to the last row
' of a worksheet.
'
' TruncatedRecordsCount is a variable whose value will be set
to the number of records that
' were truncated because their contents
would have gone past the
' last column of the worksheet. This can
only happen is we're splitting
' the data (i.e., SplitChar is not
vbNullString). Data truncation
' cannot happen if SplitChar is
vbNullString.
'
' ErrorNumber is a variable whose value will be set
to an error number (defined
' in the constants in the declarations
section of this module) if
' an error occurs. If no error occurs,
this will be C_ERR_NO_ERROR.
'
' ErrorMessage is a variable that will be populated
with the descriptive text
' of any error that occurs. If no error
occurs, this will be
' vbNullString.
'
' The function saves the following Application properties, then turns
them off. It will restore the saved
' values at the end of the function or when the function exits.
' Calculation
' ScreenUpdating
' DisplayAlerts
' EnableEvents
'
'-------------------------
' Possible Data Loss
'-------------------------
' As noted in the descriptions of the SplitChar and
TruncatedRecordsCount parameters, it is possible that
' some data loss may occur if the function is splitting the input data
into multiple columns. If the number
' of data elements in the input record plus the value of StartColumn
is greater than the number of columns
' in the worksheet, data elements that would go past the right-most
column of the worksheet are not imported.
' The number of these truncated records is returned in the
TruncatedRecordsCount variable.
'
'-------------------------
' Return Value:
'-------------------------
' The function returns the number of records imported, or -1 if an
error occurred. If the result is
' -1, the variable ErrorMessage will contain the description of the
error.
'
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim RowNdx As Long ' Current RowNumber.
Dim RowsThisSheet As Long ' The number of rows we've
populated on the current sheet (WS).
Dim Colndx As Long ' Current Column.
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 SplitChar.
Dim SheetNumber As Long ' Increments for each worksheet we
populate with data.
Dim SaveCalc As XlCalculation ' Caller's Calculation setting.
Dim SaveDisplayAlerts As Boolean ' Caller's DisplayAlerts setting.
Dim SaveScreenUpdating As Boolean ' Caller's ScreenUpdating setting.
Dim SaveEnableEvents As Boolean ' Caller's EnableEvents setting.
Dim InputCounter As Long ' Counts of all records imported
Dim TruncatedCount As Long ' Counts the number of records
whose output was truncated because
' it would have gone past the last
column of the worksheet.
''''''''''''''''''''''''''''''''''''''''''''''''''''
' Initilaize our variables
''''''''''''''''''''''''''''''''''''''''''''''''''''
SheetNumber = 1
ErrorMessage = vbNullString
ErrorNumber = C_ERR_IMPORT_NO_ERROR
TruncatedRecordsCount = 0
'''''''''''''''''''''''''''''''''''''''''''''
' Ensure we have an active workbook.
'''''''''''''''''''''''''''''''''''''''''''''
If Application.ActiveWorkbook Is Nothing Then
ErrorNumber = C_ERR_IMPORT_NO_ACTIVEWORKBOOK
ErrorMessage = "There is no active workbook in which to import the
data."
F_ImportBigTextFile = -1
Exit Function
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. If this value is > 0, a message
' indicating this is placed in ErrorMessage
' at the end of this procedure.
''''''''''''''''''''''''''''''''''''''''''''''
If SplitChar <> vbNullString Then
SplitChar = Left(SplitChar, 1)
End If
'''''''''''''''''''''''''''''''''''''''
' ensure we have a file name
'''''''''''''''''''''''''''''''''''''''
If FileName = vbNullString Then
ErrorMessage = "The filename is empty."
ErrorNumber = C_ERR_IMPORT_FILENAME_IS_BLANK
F_ImportBigTextFile = -1
Exit Function
End If
'''''''''''''''''''''''''''''''''''''''
' ensure the file exists
'''''''''''''''''''''''''''''''''''''''
If Dir(FileName, vbArchive + vbNormal + vbHidden + vbSystem) =
vbNullString Then
ErrorMessage = "The file '" & FileName & "' does not exist."
ErrorNumber = C_ERR_IMPORT_FILE_DOES_NOT_EXIST
F_ImportBigTextFile = -1
Exit Function
End If
''''''''''''''''''''''''''''''''''''''''''''''
' Set our starting initial destination worksheet.
' Error and exit if sheet does not exist or
' is not a worksheet (e.g., it is a chart sheet.
''''''''''''''''''''''''''''''''''''''''''''''
On Error Resume Next
Err.Clear
Set WS = ActiveWorkbook.Worksheets(StartSheetName)
If WS Is Nothing Then
ErrorNumber = C_ERR_IMPORT_START_SHEET_DOES_NOT_EXIST
ErrorMessage = "The StartSheetName (" & StartSheetName & ") does
not exist or is not a worksheet."
F_ImportBigTextFile = -1
Exit Function
End If
''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Ensure that if TemplateSheetName is not vbNullString
' it names an existing sheet and is NOT the same as
' StartSheetName.
''''''''''''''''''''''''''''''''''''''''''''''''''''''
On Error Resume Next
If TemplateSheetName <> vbNullString Then
Err.Clear
Set WS = ActiveWorkbook.Worksheets(TemplateSheetName)
If Err.Number <> 0 Then
''''''''''''''''''''''''''''''''''''''
' Sheet does not exist or is not
' a worksheet (e.g., a chart sheet).
''''''''''''''''''''''''''''''''''''''
ErrorNumber = C_ERR_IMPORT_TEMPLATE_SHEET_DOES_NOT_EXIST
ErrorMessage = "The TemplateSheetName '" & TemplateSheetName &
"' does not exist or is not a worksheet."
F_ImportBigTextFile = -1
Exit Function
End If
If StrComp(TemplateSheetName, StartSheetName, vbTextCompare) = 0
Then
ErrorNumber = C_ERR_IMPORT_TEMPLATE_SHEET_IS_START_SHEET
ErrorMessage = "The sheet named by TemplateSheetName is the
same as" & vbCrLf & _
"the sheet named by StartSheetName (" & StartSheetName &
")" & vbCrLf & _
"This is not allowed."
F_ImportBigTextFile = -1
Exit Function
End If
End If
'''''''''''''''''''''''''''''''''''''''''''''''
' Ensure the StartSheetName and the workbook
' are not protected.
'''''''''''''''''''''''''''''''''''''''''''''''
Set WS = ActiveWorkbook.Worksheets(StartSheetName)
If (WS.ProtectContents = True) Or (ActiveWorkbook.ProtectStructure =
True) Then
ErrorNumber = C_ERR_IMPORT_PROTECTION_ERROR
ErrorMessage = "Either the worksheet '" & WS.Name & "' or the
ActiveWorkbook is protected."
F_ImportBigTextFile = -1
Exit Function
End If
'''''''''''''''''''''''''''''''''''''''''''''''
' Ensure the TemplateSheet is not protected.
'''''''''''''''''''''''''''''''''''''''''''''''
If TemplateSheetName <> vbNullString Then
If ActiveWorkbook.Worksheets(TemplateSheetName).ProtectContents =
True Then
ErrorNumber = C_ERR_IMPORT_PROTECTION_ERROR
ErrorMessage = "The Template worksheet (" & TemplateSheetName
& ") is protected."
F_ImportBigTextFile = -1
Exit Function
End If
End If
On Error GoTo 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.
'''''''''''''''''''''''''''''''''''''''''''''
If LastRowForInput <= 0 Then
LastRowForInput = Rows.Count
ElseIf LastRowForInput > Rows.Count Then
ErrorNumber =
C_ERR_IMPORT_LASTROWFORINPUT_IS_GREATER_THAN_NUMBER_OF_ROWS
ErrorMessage = "The LsatRowForInput value is greater than the
number of rows."
F_ImportBigTextFile = -1
Exit Function
End If
'''''''''''''''''''''''''''''''''''''''''''''
' See if the file FileName is open by another
' process. If it is, exit the procedure.
'''''''''''''''''''''''''''''''''''''''''''''
If IsFileOpen(FileName:=CVar(FileName)) = True Then
ErrorNumber = C_ERR_IMPORT_FILE_IS_OPEN
ErrorMessage = "The file '" & FileName & "' is open by another
process."
F_ImportBigTextFile = -1
Exit Function
End If
''''''''''''''''''''''''''''''''''''''''''''
' ensure we have a non-empty sheetname prefix
'''''''''''''''''''''''''''''''''''''''''''
If SheetNamePrefix = vbNullString Then
ErrorNumber = C_ERR_IMPORT_SHEETNAMEPREFIX_IS_EMPTY
ErrorMessage = "The SheetNamePrefix value is empty."
F_ImportBigTextFile = -1
Exit Function
End If
''''''''''''''''''''''''''''''''''''''''''''''''''
' Ensure that SheetNamePrefix is <= 29 characters.
' This leaves us two characters for the numeric
' suffix.
''''''''''''''''''''''''''''''''''''''''''''''''''
If Len(SheetNamePrefix) > 29 Then
ErrorNumber = C_ERR_IMPORT_SHEET_PREFIX_TOO_LONG
ErrorMessage = "The SheetNamePrefix must have between 1 and 29
characters." & vbCrLf & _
"The specified SheetNamePrefix has " & CStr(Len
(SheetNamePrefix)) & " characters."
F_ImportBigTextFile = -1
Exit Function
End If
If StartRowFirstPage <= 0 Then
ErrorNumber = C_ERR_IMPORT_STARTROWFIRSTPAGE_LESS_THAN_ZERO
ErrorMessage = "The StartRowFirstPage value is less than or equal
to 0."
F_ImportBigTextFile = -1
Exit Function
End If
If StartRowFirstPage > WS.Rows.Count Then
ErrorNumber =
C_ERR_IMPORT_STARTROWFIRSTPAGE_IS_GREATER_THAN_NUMBER_OF_ROWS
ErrorMessage = "The StartRowFirstPage value is greater than the
number of rows."
F_ImportBigTextFile = -1
Exit Function
End If
If StartRowLaterPages <= 0 Then
ErrorNumber =
C_ERR_IMPORT_STARTROWLATERPAGES_LESS_THAN_EQUAL_TO_ZERO
ErrorMessage = "The StartRowLaterPages value is less than or equal
to 0."
F_ImportBigTextFile = -1
Exit Function
End If
If StartRowLaterPages > WS.Rows.Count Then
ErrorNumber =
C_ERR_IMPORT_STARATROWLATERPAGES_GREATER_THAN_NUMBER_OF_ROWS
ErrorMessage = "The StartRowLaterPages value is greater than the
number of rows."
F_ImportBigTextFile = -1
Exit Function
End If
If StartColumn <= 0 Then
ErrorNumber = C_ERR_IMPORT_START_COLUMN_IS_LESS_THAN_EQUAL_ZERO
ErrorMessage = "The StartColumn is less than or equal to 0."
F_ImportBigTextFile = -1
Exit Function
End If
If StartColumn > WS.Columns.Count Then
ErrorNumber = C_ERR_IMPORT_START_COLUMN_GREATER_THAN_NUM_COLUMNS
ErrorMessage = "The StartColumn is greater than number of
columns."
F_ImportBigTextFile = -1
Exit Function
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. All Exit Function
' statements past this point of the code
' MUST restore these settings.
''''''''''''''''''''''''''''''''''''''''''''''
SaveCalc = Application.Calculation
SaveScreenUpdating = Application.ScreenUpdating
SaveDisplayAlerts = Application.DisplayAlerts
SaveEnableEvents = Application.EnableEvents
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.EnableEvents = False
''''''''''''''''''''''''''''''''''''''''''''''
' Get a file number and open the file
''''''''''''''''''''''''''''''''''''''''''''''
On Error Resume Next
FNum = FreeFile
Err.Clear
Open FileName For Input Access Read As #FNum
If Err.Number <> 0 Then
''''''''''''''''''''''''''''''''''''''''''''''''''''
' If an error occurred, set the error variables,
' restore application settings, and then exit
' the procedure.
''''''''''''''''''''''''''''''''''''''''''''''''''''
ErrorNumber = C_ERR_IMPORT_ERROR_OPENING_FILE
ErrorMessage = "File Open Error: " & CStr(Err.Number) & "
Description: " & Err.Description
Application.Calculation = SaveCalc
Application.ScreenUpdating = SaveScreenUpdating
Application.DisplayAlerts = SaveDisplayAlerts
Application.EnableEvents = SaveEnableEvents
Application.StatusBar = False
F_ImportBigTextFile = -1
Exit Function
End If
On Error GoTo 0
''''''''''''''''''''''''''''''''''''''''''''''
' Initialize the RowNd index variable to
' StartRowFirstPage. This variable is used
' to preserve any header rows that may be
' present.
''''''''''''''''''''''''''''''''''''''''''''''
RowNdx = StartRowFirstPage
''''''''''''''''''''''''''''''''''''''''''''''
' 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
If MaxRowsPerSheet > WS.Rows.Count Then
ErrorNumber =
C_ERR_IMPORT_MAXROWSPERSHEET_GREATER_THAN_NUMBER_OF_ROWS
ErrorMessage = "The MaxRowsPerSheet parameter is greater than the
number of rows."
Close #FNum
Application.Calculation = SaveCalc
Application.ScreenUpdating = SaveScreenUpdating
Application.DisplayAlerts = SaveDisplayAlerts
Application.EnableEvents = SaveEnableEvents
F_ImportBigTextFile = -1
Exit Function
End If
On Error GoTo 0
''''''''''''''''''''''''''''''''''''''''''''''
' Loop until we hit the end of the file.
''''''''''''''''''''''''''''''''''''''''''''''
Do Until EOF(FNum)
''''''''''''''''''''''''''''''''''''''''''''''
' Get 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 UpdateStatusBarEveryNRecords > 0 Then
If InputCounter Mod UpdateStatusBarEveryNRecords = 0 Then
Application.StatusBar = StatusBarText & _
Format(InputCounter, "#,##0")
End If
End If
If SplitChar = vbNullString Then
''''''''''''''''''''''''''''''''''''''
' we're not spliting up the input, put
' the entire line in column StartColumn.
''''''''''''''''''''''''''''''''''''''
WS.Cells(RowNdx, StartColumn).Value = InputLine
Else
''''''''''''''''''''''''''''''''''''''''
' we're spliting up the input into columns.
' use Split to get an array of the items
' in InputLine, delimited by SplitChart,
' and then loop through the Arr array, putting
' each element in its own column. Use
''''''''''''''''''''''''''''''''''''''''
Arr = Split(InputLine, SplitChar, , vbTextCompare)
On Error Resume Next
For Colndx = LBound(Arr) To UBound(Arr)
''''''''''''''''''''''''''''''''''''''''''''
' Ensure that we don't try to write past the
' last column of the worksheet. If we get
' to the last column of the sheet, exit the
' For loop.
''''''''''''''''''''''''''''''''''''''''''''
If Colndx + StartColumn <= WS.Columns.Count Then
WS.Cells(RowNdx, Colndx + StartColumn).Value = Arr
(Colndx)
Else
TruncatedCount = TruncatedCount + 1
Exit For
End If
Next Colndx
On Error GoTo 0
End If
''''''''''''''''''''''''''''''''''''''''
' 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
' StartRowLaterPages.
''''''''''''''''''''''''''''''''''''''''
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 create a new worksheet,
' immediately after the current sheet, and name it
' SheetNamePrefix & Format(SheetNumber, "0")
' Reset the RowNdx value to C_START_ROW_LATER_PAGE
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''
SheetNumber = SheetNumber + 1
If TemplateSheetName = vbNullString Then
''''''''''''''''''''''''''''''''''''''''''''''''
' No template sheet was specified. Create a new
' sheet.
''''''''''''''''''''''''''''''''''''''''''''''''
Set WS = ActiveWorkbook.Worksheets.Add(after:=WS)
Else
''''''''''''''''''''''''''''''''''''''''''''''''
' A template sheet was specified. Copy that sheet
' after WS.
''''''''''''''''''''''''''''''''''''''''''''''''
ActiveWorkbook.Worksheets(TemplateSheetName).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
' SheetNamePrefix & Format(SheetNumber, "0")
' or if SheetNamePrefix contains illegal characters. In this
' case, we'll just go with Excel's default name.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
WS.Name = SheetNamePrefix & Format(SheetNumber, "0")
On Error GoTo 0
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Reset our counters.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''
RowNdx = StartRowLaterPages
RowsThisSheet = 0
End If
''''''''''''''''''''''''''''''''''''''''''''''
' end of loop
''''''''''''''''''''''''''''''''''''''''''''''
Loop
''''''''''''''''''''''''''''''''''''''''''''''
' Close the input file, restore the application
' settings, and clear the StatusBar.
''''''''''''''''''''''''''''''''''''''''''''''
Close FNum
Application.Calculation = SaveCalc
Application.ScreenUpdating = SaveScreenUpdating
Application.DisplayAlerts = SaveDisplayAlerts
Application.EnableEvents = SaveEnableEvents
Application.StatusBar = False
''''''''''''''''''''''''''''''''''''''''''''''
' return the number of records imported.
' If one or more rows of data were truncated,
' put this message in the ErrorMessage variable.
''''''''''''''''''''''''''''''''''''''''''''''
TruncatedRecordsCount = TruncatedCount
F_ImportBigTextFile = InputCounter
End Function
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 Integer
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.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
If Dir(FileName, 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
ErrNum = Err.Number ' Save the error number that occurred.
On Error GoTo 0 ' Turn error checking back on.
Close FileNum ' Close the file.
' Check to see which error occurred.
Select Case ErrNum
Case C_ERR_NO_ERROR
' No error occurred.
' File is NOT already open by another user.
IsFileOpen = False
Case C_ERR_PERMISSION_DENIED
' Error number for "Permission Denied."
' File is already opened by another user.
IsFileOpen = True
' Another error occurred.
Case Else
IsFileOpen = True
End Select
On Error Resume Next
Close FileNum ' Close the file.
End Function
excel. On this site, lots of you post code some nifty tricks that I
would love to be able to do, but I do not know visual basic. I would
appreciate it if some one can walk me step by step through the process
of loading the code, changing the code, creating the macro to run the
code, and running the code. Below is an example of code I saw on this
site that I would love to be able to run. Your help is appreciated.
=======================================================================
Attribute VB_Name = "modImportBigFilesFunction"
Option Explicit
Option Compare Text
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' modImportBigFilesFunction
' By Chip Pearson, (e-mail address removed) www.cpearson.com
' This function requires Excel 2000 or later.
'
' Complete documentation and usage considerations are provided in the
comments that follow
' the procedure declaration. This module also includes the Private
procedure IsFileOpen which
' determines whether a file is open by another process.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Error Number Constants
' All error number constants begin with "C_ERR_IMPORT_".
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Const C_ERR_IMPORT_NO_ERROR = 0&
Public Const C_ERR_IMPORT_FILENAME_IS_BLANK = 1&
Public Const C_ERR_IMPORT_FILE_DOES_NOT_EXIST = 2&
Public Const C_ERR_IMPORT_START_SHEET_DOES_NOT_EXIST = 3&
Public Const
C_ERR_IMPORT_LASTROWFORINPUT_IS_GREATER_THAN_NUMBER_OF_ROWS = 4&
Public Const C_ERR_IMPORT_FILE_IS_OPEN = 5&
Public Const C_ERR_IMPORT_SHEETNAMEPREFIX_IS_EMPTY = 6&
Public Const C_ERR_IMPORT_STARTROWFIRSTPAGE_LESS_THAN_ZERO = 7&
Public Const
C_ERR_IMPORT_STARTROWFIRSTPAGE_IS_GREATER_THAN_NUMBER_OF_ROWS = 8&
Public Const C_ERR_IMPORT_STARTROWLATERPAGES_LESS_THAN_EQUAL_TO_ZERO =
9&
Public Const
C_ERR_IMPORT_STARATROWLATERPAGES_GREATER_THAN_NUMBER_OF_ROWS = 10&
Public Const C_ERR_IMPORT_START_COLUMN_IS_LESS_THAN_EQUAL_ZERO = 11&
Public Const C_ERR_IMPORT_START_COLUMN_GREATER_THAN_NUM_COLUMNS = 12&
Public Const C_ERR_IMPORT_ERROR_OPENING_FILE = 13&
Public Const C_ERR_IMPORT_MAXROWSPERSHEET_GREATER_THAN_NUMBER_OF_ROWS
= 14&
Public Const C_ERR_IMPORT_NO_ACTIVEWORKBOOK = 15&
Public Const C_ERR_IMPORT_PROTECTION_ERROR = 16&
Public Const C_ERR_IMPORT_SHEET_PREFIX_TOO_LONG = 17&
Public Const C_ERR_IMPORT_TEMPLATE_SHEET_DOES_NOT_EXIST = 18&
Public Const C_ERR_IMPORT_TEMPLATE_SHEET_IS_START_SHEET = 19&
Public Const C_ERR_IMPORT_START_SHEET_IS_NOT_WORKSHEET = 20&
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' F_ImportBigTextFile
' This function imports a text or CSV file into an Excel workbook. It
can
' handle any number of records, and will create additional worksheets
as
' needed. Full documentation follows the function declaration.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Function F_ImportBigTextFile(FileName As String, _
ByVal SplitChar As String, _
SheetNamePrefix As String, _
TemplateSheetName As String, _
StartRowFirstPage As Long, _
StartRowLaterPages As Long, _
StartSheetName As String, _
StartColumn As Long, _
UpdateStatusBarEveryNRecords As
Long, _
StatusBarText As String, _
LastRowForInput As Long, _
MaxRowsPerSheet As Long, _
ByRef TruncatedRecordsCount As
Long, _
ByRef ErrorNumber As Long, _
ByRef ErrorMessage As String) As
Long
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' F_ImportBigTextFile
' By Chip Pearson, (e-mail address removed), www.cpearson.com
' This procedure is on http://www.cpearson.com/excel/ImportBigFiles.htm
' This function requires Excel 2000 or later.
'
' An Excel worksheet (2003 and earlier) is limited to 65,536 rows. You
cannot increase this
' limit. Therefore, if you try to use Excel's tools ("Import External
Data") to import a text
' or csv file with more than 65,536 rows of data, Excel will only
import the first 65,536 records. This procedure
' may be used to import a text file of any number of rows. It will
begin the import by placing
' the imported data on the sheet named in C_START_SHEET_NAME starting
in row StartRowFirstPage.
'
' Note that the import process always writes records to the
ActiveWorkbook, which may or may not
' be the same workbook that contains this code. Ensure that the proper
workbook is active
' prior to running the import process.
'
' When any one or more of the following are true:
'
' RowNdx > Rows.Count
' RowNdx > LastRowForInput
' RowsThisSheet > MaxRowsPerSheet
'
' the procedure will create a new worksheet immediately following the
current worksheet, and
' name it
' SheetNamePrefix & Format(SheetNumber, "0")
'
' The procedure will optionally split the input into multiple columns,
delimited by a characer.
' The following procedure parameters determine how the procedure
handles data and new worksheets:
'
' FileName is the name of the file to import.
'
' SplitChar is the character which delimits the
data fields in the input data.
' If this character is vbNullString, the
entire input line of data
' will be placed in StartColumn. If
SplitChar is not vbNullString,
' it is truncated to 1 character and
then used in the Split function
' to split the input data into an array.
' Each element of the array is put into
its own column. SplitChar
' is typically set to a comma,
semicolon, or vbTab, but it may be any
' character. It is possible that
splitting the data across columns may
' result in data loss.
' If the number of data fields +
StartColumn is greater than the number
' of columns in the worksheet (256), the
right most data element(s) will
' not be imported. The number of
trucated records is returned to
' the TruncatedRecordsCount variable.
'
' SheetNamePrefix is the name used to create new
worksheets. A numeric
' sequence number will be appended to
this value to
' create the sheet name.
'
' TemplateSheetName is the name of an existing worksheet
that will be used
' as the template sheet for all
subsequent worksheets created
' by the procedure. This may NOT be the
same as StartSheetName.
' If you don't want to use a template
sheet, set this parameter
' to vbNullString.
'
' StartRowFirstPage is the row number on the first
worksheet (C_START_SHEET_NAME)
' where the data should be placed. This
is used if you have
' header rows that you don't want to
over write.
'
' StartRowLaterPages is the row number on subsequent (sheet
2, 3, etc) that the
' data should be placed.
'
' StartSheetName is the name of an existing worksheet.
The imported data will
' start by filling this sheet before
creating a new worksheet.
' This may NOT be the same as
TemplateSheetName.
'
' StartColumn is the column in which the data is
placed. If SplitChar is
' vbNullString, the entire line of input
data will be placed
' in this column. If SplitChar is not
vbNullString, the input
' data is split into an array using
SplitChar as a delimiter,
' and each data element will be put in
its own column, starting
' with StartColumn.
'
' UpdateStatusBarEveryNSeconds
' is the number of records after which
the a message will
' be displayed in the StatusBar. Set
this value to <= 0 if you
' do not want any StatusBar updates.
'
' StatusBarText is the text to be displayed in the
StatusBar. The current
' count will be appended to this text.
This value is not used
' if UpdateStatusBarEveryNSeconds is <=
0.
'
'
' LastRowForInput is the last row number on a worksheet
that the imported data
' should be placed. Set this to either
<= 0 or to Rows.Count
' to import data to the last row of the
worksheet.
'
' MaxRowsPerSheet is the maximum number of rows to
import on to a single worksheet.
' Set this to <= 0 or Rows.Count to
import to the last row
' of a worksheet.
'
' TruncatedRecordsCount is a variable whose value will be set
to the number of records that
' were truncated because their contents
would have gone past the
' last column of the worksheet. This can
only happen is we're splitting
' the data (i.e., SplitChar is not
vbNullString). Data truncation
' cannot happen if SplitChar is
vbNullString.
'
' ErrorNumber is a variable whose value will be set
to an error number (defined
' in the constants in the declarations
section of this module) if
' an error occurs. If no error occurs,
this will be C_ERR_NO_ERROR.
'
' ErrorMessage is a variable that will be populated
with the descriptive text
' of any error that occurs. If no error
occurs, this will be
' vbNullString.
'
' The function saves the following Application properties, then turns
them off. It will restore the saved
' values at the end of the function or when the function exits.
' Calculation
' ScreenUpdating
' DisplayAlerts
' EnableEvents
'
'-------------------------
' Possible Data Loss
'-------------------------
' As noted in the descriptions of the SplitChar and
TruncatedRecordsCount parameters, it is possible that
' some data loss may occur if the function is splitting the input data
into multiple columns. If the number
' of data elements in the input record plus the value of StartColumn
is greater than the number of columns
' in the worksheet, data elements that would go past the right-most
column of the worksheet are not imported.
' The number of these truncated records is returned in the
TruncatedRecordsCount variable.
'
'-------------------------
' Return Value:
'-------------------------
' The function returns the number of records imported, or -1 if an
error occurred. If the result is
' -1, the variable ErrorMessage will contain the description of the
error.
'
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim RowNdx As Long ' Current RowNumber.
Dim RowsThisSheet As Long ' The number of rows we've
populated on the current sheet (WS).
Dim Colndx As Long ' Current Column.
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 SplitChar.
Dim SheetNumber As Long ' Increments for each worksheet we
populate with data.
Dim SaveCalc As XlCalculation ' Caller's Calculation setting.
Dim SaveDisplayAlerts As Boolean ' Caller's DisplayAlerts setting.
Dim SaveScreenUpdating As Boolean ' Caller's ScreenUpdating setting.
Dim SaveEnableEvents As Boolean ' Caller's EnableEvents setting.
Dim InputCounter As Long ' Counts of all records imported
Dim TruncatedCount As Long ' Counts the number of records
whose output was truncated because
' it would have gone past the last
column of the worksheet.
''''''''''''''''''''''''''''''''''''''''''''''''''''
' Initilaize our variables
''''''''''''''''''''''''''''''''''''''''''''''''''''
SheetNumber = 1
ErrorMessage = vbNullString
ErrorNumber = C_ERR_IMPORT_NO_ERROR
TruncatedRecordsCount = 0
'''''''''''''''''''''''''''''''''''''''''''''
' Ensure we have an active workbook.
'''''''''''''''''''''''''''''''''''''''''''''
If Application.ActiveWorkbook Is Nothing Then
ErrorNumber = C_ERR_IMPORT_NO_ACTIVEWORKBOOK
ErrorMessage = "There is no active workbook in which to import the
data."
F_ImportBigTextFile = -1
Exit Function
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. If this value is > 0, a message
' indicating this is placed in ErrorMessage
' at the end of this procedure.
''''''''''''''''''''''''''''''''''''''''''''''
If SplitChar <> vbNullString Then
SplitChar = Left(SplitChar, 1)
End If
'''''''''''''''''''''''''''''''''''''''
' ensure we have a file name
'''''''''''''''''''''''''''''''''''''''
If FileName = vbNullString Then
ErrorMessage = "The filename is empty."
ErrorNumber = C_ERR_IMPORT_FILENAME_IS_BLANK
F_ImportBigTextFile = -1
Exit Function
End If
'''''''''''''''''''''''''''''''''''''''
' ensure the file exists
'''''''''''''''''''''''''''''''''''''''
If Dir(FileName, vbArchive + vbNormal + vbHidden + vbSystem) =
vbNullString Then
ErrorMessage = "The file '" & FileName & "' does not exist."
ErrorNumber = C_ERR_IMPORT_FILE_DOES_NOT_EXIST
F_ImportBigTextFile = -1
Exit Function
End If
''''''''''''''''''''''''''''''''''''''''''''''
' Set our starting initial destination worksheet.
' Error and exit if sheet does not exist or
' is not a worksheet (e.g., it is a chart sheet.
''''''''''''''''''''''''''''''''''''''''''''''
On Error Resume Next
Err.Clear
Set WS = ActiveWorkbook.Worksheets(StartSheetName)
If WS Is Nothing Then
ErrorNumber = C_ERR_IMPORT_START_SHEET_DOES_NOT_EXIST
ErrorMessage = "The StartSheetName (" & StartSheetName & ") does
not exist or is not a worksheet."
F_ImportBigTextFile = -1
Exit Function
End If
''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Ensure that if TemplateSheetName is not vbNullString
' it names an existing sheet and is NOT the same as
' StartSheetName.
''''''''''''''''''''''''''''''''''''''''''''''''''''''
On Error Resume Next
If TemplateSheetName <> vbNullString Then
Err.Clear
Set WS = ActiveWorkbook.Worksheets(TemplateSheetName)
If Err.Number <> 0 Then
''''''''''''''''''''''''''''''''''''''
' Sheet does not exist or is not
' a worksheet (e.g., a chart sheet).
''''''''''''''''''''''''''''''''''''''
ErrorNumber = C_ERR_IMPORT_TEMPLATE_SHEET_DOES_NOT_EXIST
ErrorMessage = "The TemplateSheetName '" & TemplateSheetName &
"' does not exist or is not a worksheet."
F_ImportBigTextFile = -1
Exit Function
End If
If StrComp(TemplateSheetName, StartSheetName, vbTextCompare) = 0
Then
ErrorNumber = C_ERR_IMPORT_TEMPLATE_SHEET_IS_START_SHEET
ErrorMessage = "The sheet named by TemplateSheetName is the
same as" & vbCrLf & _
"the sheet named by StartSheetName (" & StartSheetName &
")" & vbCrLf & _
"This is not allowed."
F_ImportBigTextFile = -1
Exit Function
End If
End If
'''''''''''''''''''''''''''''''''''''''''''''''
' Ensure the StartSheetName and the workbook
' are not protected.
'''''''''''''''''''''''''''''''''''''''''''''''
Set WS = ActiveWorkbook.Worksheets(StartSheetName)
If (WS.ProtectContents = True) Or (ActiveWorkbook.ProtectStructure =
True) Then
ErrorNumber = C_ERR_IMPORT_PROTECTION_ERROR
ErrorMessage = "Either the worksheet '" & WS.Name & "' or the
ActiveWorkbook is protected."
F_ImportBigTextFile = -1
Exit Function
End If
'''''''''''''''''''''''''''''''''''''''''''''''
' Ensure the TemplateSheet is not protected.
'''''''''''''''''''''''''''''''''''''''''''''''
If TemplateSheetName <> vbNullString Then
If ActiveWorkbook.Worksheets(TemplateSheetName).ProtectContents =
True Then
ErrorNumber = C_ERR_IMPORT_PROTECTION_ERROR
ErrorMessage = "The Template worksheet (" & TemplateSheetName
& ") is protected."
F_ImportBigTextFile = -1
Exit Function
End If
End If
On Error GoTo 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.
'''''''''''''''''''''''''''''''''''''''''''''
If LastRowForInput <= 0 Then
LastRowForInput = Rows.Count
ElseIf LastRowForInput > Rows.Count Then
ErrorNumber =
C_ERR_IMPORT_LASTROWFORINPUT_IS_GREATER_THAN_NUMBER_OF_ROWS
ErrorMessage = "The LsatRowForInput value is greater than the
number of rows."
F_ImportBigTextFile = -1
Exit Function
End If
'''''''''''''''''''''''''''''''''''''''''''''
' See if the file FileName is open by another
' process. If it is, exit the procedure.
'''''''''''''''''''''''''''''''''''''''''''''
If IsFileOpen(FileName:=CVar(FileName)) = True Then
ErrorNumber = C_ERR_IMPORT_FILE_IS_OPEN
ErrorMessage = "The file '" & FileName & "' is open by another
process."
F_ImportBigTextFile = -1
Exit Function
End If
''''''''''''''''''''''''''''''''''''''''''''
' ensure we have a non-empty sheetname prefix
'''''''''''''''''''''''''''''''''''''''''''
If SheetNamePrefix = vbNullString Then
ErrorNumber = C_ERR_IMPORT_SHEETNAMEPREFIX_IS_EMPTY
ErrorMessage = "The SheetNamePrefix value is empty."
F_ImportBigTextFile = -1
Exit Function
End If
''''''''''''''''''''''''''''''''''''''''''''''''''
' Ensure that SheetNamePrefix is <= 29 characters.
' This leaves us two characters for the numeric
' suffix.
''''''''''''''''''''''''''''''''''''''''''''''''''
If Len(SheetNamePrefix) > 29 Then
ErrorNumber = C_ERR_IMPORT_SHEET_PREFIX_TOO_LONG
ErrorMessage = "The SheetNamePrefix must have between 1 and 29
characters." & vbCrLf & _
"The specified SheetNamePrefix has " & CStr(Len
(SheetNamePrefix)) & " characters."
F_ImportBigTextFile = -1
Exit Function
End If
If StartRowFirstPage <= 0 Then
ErrorNumber = C_ERR_IMPORT_STARTROWFIRSTPAGE_LESS_THAN_ZERO
ErrorMessage = "The StartRowFirstPage value is less than or equal
to 0."
F_ImportBigTextFile = -1
Exit Function
End If
If StartRowFirstPage > WS.Rows.Count Then
ErrorNumber =
C_ERR_IMPORT_STARTROWFIRSTPAGE_IS_GREATER_THAN_NUMBER_OF_ROWS
ErrorMessage = "The StartRowFirstPage value is greater than the
number of rows."
F_ImportBigTextFile = -1
Exit Function
End If
If StartRowLaterPages <= 0 Then
ErrorNumber =
C_ERR_IMPORT_STARTROWLATERPAGES_LESS_THAN_EQUAL_TO_ZERO
ErrorMessage = "The StartRowLaterPages value is less than or equal
to 0."
F_ImportBigTextFile = -1
Exit Function
End If
If StartRowLaterPages > WS.Rows.Count Then
ErrorNumber =
C_ERR_IMPORT_STARATROWLATERPAGES_GREATER_THAN_NUMBER_OF_ROWS
ErrorMessage = "The StartRowLaterPages value is greater than the
number of rows."
F_ImportBigTextFile = -1
Exit Function
End If
If StartColumn <= 0 Then
ErrorNumber = C_ERR_IMPORT_START_COLUMN_IS_LESS_THAN_EQUAL_ZERO
ErrorMessage = "The StartColumn is less than or equal to 0."
F_ImportBigTextFile = -1
Exit Function
End If
If StartColumn > WS.Columns.Count Then
ErrorNumber = C_ERR_IMPORT_START_COLUMN_GREATER_THAN_NUM_COLUMNS
ErrorMessage = "The StartColumn is greater than number of
columns."
F_ImportBigTextFile = -1
Exit Function
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. All Exit Function
' statements past this point of the code
' MUST restore these settings.
''''''''''''''''''''''''''''''''''''''''''''''
SaveCalc = Application.Calculation
SaveScreenUpdating = Application.ScreenUpdating
SaveDisplayAlerts = Application.DisplayAlerts
SaveEnableEvents = Application.EnableEvents
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.EnableEvents = False
''''''''''''''''''''''''''''''''''''''''''''''
' Get a file number and open the file
''''''''''''''''''''''''''''''''''''''''''''''
On Error Resume Next
FNum = FreeFile
Err.Clear
Open FileName For Input Access Read As #FNum
If Err.Number <> 0 Then
''''''''''''''''''''''''''''''''''''''''''''''''''''
' If an error occurred, set the error variables,
' restore application settings, and then exit
' the procedure.
''''''''''''''''''''''''''''''''''''''''''''''''''''
ErrorNumber = C_ERR_IMPORT_ERROR_OPENING_FILE
ErrorMessage = "File Open Error: " & CStr(Err.Number) & "
Description: " & Err.Description
Application.Calculation = SaveCalc
Application.ScreenUpdating = SaveScreenUpdating
Application.DisplayAlerts = SaveDisplayAlerts
Application.EnableEvents = SaveEnableEvents
Application.StatusBar = False
F_ImportBigTextFile = -1
Exit Function
End If
On Error GoTo 0
''''''''''''''''''''''''''''''''''''''''''''''
' Initialize the RowNd index variable to
' StartRowFirstPage. This variable is used
' to preserve any header rows that may be
' present.
''''''''''''''''''''''''''''''''''''''''''''''
RowNdx = StartRowFirstPage
''''''''''''''''''''''''''''''''''''''''''''''
' 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
If MaxRowsPerSheet > WS.Rows.Count Then
ErrorNumber =
C_ERR_IMPORT_MAXROWSPERSHEET_GREATER_THAN_NUMBER_OF_ROWS
ErrorMessage = "The MaxRowsPerSheet parameter is greater than the
number of rows."
Close #FNum
Application.Calculation = SaveCalc
Application.ScreenUpdating = SaveScreenUpdating
Application.DisplayAlerts = SaveDisplayAlerts
Application.EnableEvents = SaveEnableEvents
F_ImportBigTextFile = -1
Exit Function
End If
On Error GoTo 0
''''''''''''''''''''''''''''''''''''''''''''''
' Loop until we hit the end of the file.
''''''''''''''''''''''''''''''''''''''''''''''
Do Until EOF(FNum)
''''''''''''''''''''''''''''''''''''''''''''''
' Get 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 UpdateStatusBarEveryNRecords > 0 Then
If InputCounter Mod UpdateStatusBarEveryNRecords = 0 Then
Application.StatusBar = StatusBarText & _
Format(InputCounter, "#,##0")
End If
End If
If SplitChar = vbNullString Then
''''''''''''''''''''''''''''''''''''''
' we're not spliting up the input, put
' the entire line in column StartColumn.
''''''''''''''''''''''''''''''''''''''
WS.Cells(RowNdx, StartColumn).Value = InputLine
Else
''''''''''''''''''''''''''''''''''''''''
' we're spliting up the input into columns.
' use Split to get an array of the items
' in InputLine, delimited by SplitChart,
' and then loop through the Arr array, putting
' each element in its own column. Use
''''''''''''''''''''''''''''''''''''''''
Arr = Split(InputLine, SplitChar, , vbTextCompare)
On Error Resume Next
For Colndx = LBound(Arr) To UBound(Arr)
''''''''''''''''''''''''''''''''''''''''''''
' Ensure that we don't try to write past the
' last column of the worksheet. If we get
' to the last column of the sheet, exit the
' For loop.
''''''''''''''''''''''''''''''''''''''''''''
If Colndx + StartColumn <= WS.Columns.Count Then
WS.Cells(RowNdx, Colndx + StartColumn).Value = Arr
(Colndx)
Else
TruncatedCount = TruncatedCount + 1
Exit For
End If
Next Colndx
On Error GoTo 0
End If
''''''''''''''''''''''''''''''''''''''''
' 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
' StartRowLaterPages.
''''''''''''''''''''''''''''''''''''''''
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 create a new worksheet,
' immediately after the current sheet, and name it
' SheetNamePrefix & Format(SheetNumber, "0")
' Reset the RowNdx value to C_START_ROW_LATER_PAGE
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''
SheetNumber = SheetNumber + 1
If TemplateSheetName = vbNullString Then
''''''''''''''''''''''''''''''''''''''''''''''''
' No template sheet was specified. Create a new
' sheet.
''''''''''''''''''''''''''''''''''''''''''''''''
Set WS = ActiveWorkbook.Worksheets.Add(after:=WS)
Else
''''''''''''''''''''''''''''''''''''''''''''''''
' A template sheet was specified. Copy that sheet
' after WS.
''''''''''''''''''''''''''''''''''''''''''''''''
ActiveWorkbook.Worksheets(TemplateSheetName).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
' SheetNamePrefix & Format(SheetNumber, "0")
' or if SheetNamePrefix contains illegal characters. In this
' case, we'll just go with Excel's default name.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
WS.Name = SheetNamePrefix & Format(SheetNumber, "0")
On Error GoTo 0
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Reset our counters.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''
RowNdx = StartRowLaterPages
RowsThisSheet = 0
End If
''''''''''''''''''''''''''''''''''''''''''''''
' end of loop
''''''''''''''''''''''''''''''''''''''''''''''
Loop
''''''''''''''''''''''''''''''''''''''''''''''
' Close the input file, restore the application
' settings, and clear the StatusBar.
''''''''''''''''''''''''''''''''''''''''''''''
Close FNum
Application.Calculation = SaveCalc
Application.ScreenUpdating = SaveScreenUpdating
Application.DisplayAlerts = SaveDisplayAlerts
Application.EnableEvents = SaveEnableEvents
Application.StatusBar = False
''''''''''''''''''''''''''''''''''''''''''''''
' return the number of records imported.
' If one or more rows of data were truncated,
' put this message in the ErrorMessage variable.
''''''''''''''''''''''''''''''''''''''''''''''
TruncatedRecordsCount = TruncatedCount
F_ImportBigTextFile = InputCounter
End Function
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 Integer
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.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
If Dir(FileName, 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
ErrNum = Err.Number ' Save the error number that occurred.
On Error GoTo 0 ' Turn error checking back on.
Close FileNum ' Close the file.
' Check to see which error occurred.
Select Case ErrNum
Case C_ERR_NO_ERROR
' No error occurred.
' File is NOT already open by another user.
IsFileOpen = False
Case C_ERR_PERMISSION_DENIED
' Error number for "Permission Denied."
' File is already opened by another user.
IsFileOpen = True
' Another error occurred.
Case Else
IsFileOpen = True
End Select
On Error Resume Next
Close FileNum ' Close the file.
End Function