Importing a CSV file delimited with commas but with commas in a field as well

JohnE1054

New Member
Joined
Dec 8, 2009
Messages
15
I am trying to import a CSV file with comma delimiters. However one of the fields has a comma (that is not a delimiter) in it. For example 'Home Depot,Inc'. I have code that imports it but then it puts the 'Inc' into the next field over, etc. etc.
When I use the Import External Data wizard and check the comma as the delimiter AND have the text qualifier as ", it imports it correctly. But I'm trying to somehow change what I have already written to do the same thing since my code does some other things.
I'll include my code that I already have, which is rather long:

Sub ImportBigTextFile()
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' ImportBigTextFiles
'
' This procedure may be used to import a text
' or CSV 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 C_START_ROW_FIRST_PAGE.
'
' RowNdx is the current row number where the input record will be placed. 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
' C_SHEET_NAME_PREFIX & Format(SheetNumber, "0")
'
' The procedure will optionally split the input data into multiple columns, delimited by a
' character specified in the SplitChar variable.
'
' The following constants and variable determine how the procedure handles data and new worksheets:
'
' C_START_ROW_FIRST_PAGE 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 want to preserve.
'
' C_START_ROW_LATER_PAGES is the row number on subsequent (sheet 2, 3, etc) that the
' data should be started.
'
' C_START_SHEET_NAME is the name of an existing worksheet. The imported data will
' start by filling this sheet before creating a new worksheet.
'
' C_START_COLUMN 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 C_START_COLUMN.
'
' C_TEMPLATE_SHEET_NAME is the name of an existing worksheet that is used as the
' template for each new sheet created by the function. This
' must NOT be the same as C_START_SHEET_NAME, since copying
' C_START_SHEET_NAME would copy all of the imported (so far)
' data to the new sheet. If you don't want to use a template
' sheet, set this constant to vbNullString.
'
' C_UPDATE_STATUSBAR_EVERY_N_RECORDS
' 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. A typical value for this
' constant is 1000.
'
' C_STATUSBAR_TEXT is the text to be displayed in the StatusBar. The current record
' count will be appnded to this text. This value is not used
' if C_UPDATE_STATUSBAR_EVERY_N_RECORDS is <= 0. The string
' value in this constant should include a trailing space. A
' typical value for this constant is "Processing Record: "
'
' C_SHEET_NAME_PREFIX is a string value which will be used for naming newly created
' worksheets. This constant must have <= 28 characters, which
' leaves the procedure three characters for the numeric suffix.
' This allows for importing 65,404,928 rows. If there are more
' rows, the proceudre will import them, but the worksheet names
' may not be named properly. They will, however, be in the proper
' sequence.
'
' 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. While the procedure can properely handle values
' in both LastRowForInput and MaxRowsPerSheet, you will most likely
' set both to <=0 or set one to <= 0 and the other to its appropriate
' value. Typically, both variables will not have non-zero values.
'
' 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 C_START_COLUMN. If SplitChar is not vbNullString,
' it is truncated to 1 character (the left-most character) and then used
' in Split function to split the input data into an array, delimited by SplitChar.
' Each element of the array is put into its own column, starting with
' C_START_COLUMN and proceeding to the right. SplitChar is typically set
' to a comma, semicolon, or vbTab, but it can be any character.
'
' The procedure saves the following Application properties, then turns them off. It will restore the saved
' values at the end of the procedure.
' Calculation
' ScreenUpdating
' DisplayAlerts
' EnableEvents
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'this just confirms that you REALLY want to run this macro
If MsgBox("Do you REALLY want to import the file and do all this stuff automatically?", vbYesNo + vbQuestion) = vbNo Then Exit Sub
If MsgBox("Did you fix the output file and get rid of the commas in the customer name field?", vbYesNo + vbQuestion) = vbNo Then Exit Sub

' data starts on this row on the first sheet
Const C_START_ROW_FIRST_PAGE = 1 '3
' 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 = "Paste Spcl Values from 45-2 Rpt"
' what column do we start placing the data
Const C_START_COLUMN = 1
' 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.
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")
FName = Application.GetOpenFilename(FileFilter:="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
''''''''''''''''''''''''''''''''''''''''
'NOTE : this deletes contents of sheet
'C_START_SHEET_NAME
' Range("A1:AZ9000").ClearContents
'Sheet1.Cells.ClearContents
Worksheets("Paste Spcl Values from 45-2 Rpt").Cells.ClearContents
''''''''''''''''''''''''''''''''''''''''''''''
' 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
ws.Cells(RowNdx, Colndx + C_START_COLUMN).Value = Arr(Colndx)
Else
TruncatedCount = TruncatedCount + 1
Exit For
End If
Next Colndx
End If ' SplitChar = vbNullString


'''''''''''''''''''''''''''''''''''''''
' Increment the RowNdx index variable.
' If it is greater than either of the following:
' Rows.Count
' LastRowForInput
' or if RowsThisSheet is > MaxRowsPerSheet
' then create and name a new worksheet and
' reset the RowNdx index variable to
' C_START_ROW_LATER_PAGES.
''''''''''''''''''''''''''''''''''''''''
RowNdx = RowNdx + 1
If (RowNdx > Rows.Count) Or (RowNdx > LastRowForInput) Or (RowsThisSheet > MaxRowsPerSheet) Then
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' We're past the end of the worksheet or past the row
' specified in LastRowForInput or the rows used on this
' worksheet is greater than MaxRowsPerSheet.
'
' Increment the SheetNumber index and either create a
' new sheet (if C_TEMPLATE_SHEET_NAME is vbNullString) or
' copy the C_TEMPLATE_SHEET_NAME worksheet
' immediately after the current sheet, and name it
' C_SHEET_NAME_PREFIX & Format(SheetNumber, "0")
' Reset the RowNdx value to C_START_ROW_LATER_PAGE
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''
SheetNumber = SheetNumber + 1
If C_TEMPLATE_SHEET_NAME = vbNullString Then
Set ws = ActiveWorkbook.Worksheets.Add(after:=ws)
Else
ActiveWorkbook.Worksheets(C_TEMPLATE_SHEET_NAME).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
''''''''''''''''''''''''''''
'When file is imported it includes quotes around most of the data
'this replaces all quotes with 'nothing'. I recorded a macro by using
'the replace all under the edit.
''''''''''''''''''''''''''''''''''
Cells.Replace What:="""", Replacement:="", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False

''''''''''''''''''''''''''''''''''''''''''''''
'This changes the type to ICT where the name is INTERCO X (intercompany transfer)
'If any row col. B has xxxx then change same row col. E to xxxx
''''''''''''''''''''''''''''''''''''''''''''''
Dim iRow As Long

For iRow = 1 To 9000
If Cells(iRow, "B") = "INTERCO E7" Then
Cells(iRow, "E") = "ICT"
End If
Next iRow
''''''''''''''''''''''''''''''''''''''''''''''
'This refreshes the aa pivot tables - note
''''''''''''''''''''''''''''''''''''''''''''''
Dim pt As PivotTable
For Each ws In ActiveWorkbook.Worksheets
For Each pt In ws.PivotTables
pt.RefreshTable
Next pt
Next ws



''''''''''''''''''''''''''''''''''''''''''''''
' 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
 

Excel Facts

How to fill five years of quarters?
Type 1Q-2023 in a cell. Grab the fill handle and drag down or right. After 4Q-2023, Excel will jump to 1Q-2024. Dash can be any character.
Why not import the file with the text qualifier and then have code that does a find and replace to remove it?

Actually just notice you apear to be doing something like that, does it not work?
 
Upvote 0
no, it doesn't work right either. If I leave that piece of code in...the INC
still shows up in another field. If I take that piece out, the HOME DEPOT has a single quote around it in one field and INC has a single quote around it the next field - see below

I don't know if I have something in the wrong place or what.

<TABLE style="WIDTH: 302pt; BORDER-COLLAPSE: collapse" cellSpacing=0 cellPadding=0 width=403 border=0 x:str><COLGROUP><COL style="WIDTH: 249pt; mso-width-source: userset; mso-width-alt: 12141" width=332><COL style="WIDTH: 53pt; mso-width-source: userset; mso-width-alt: 2596" width=71><TBODY><TR style="HEIGHT: 12.75pt" height=17><TD style="BORDER-RIGHT: #d4d0c8; BORDER-TOP: #d4d0c8; BORDER-LEFT: #d4d0c8; WIDTH: 249pt; BORDER-BOTTOM: #d4d0c8; HEIGHT: 12.75pt; BACKGROUND-COLOR: transparent" width=332 height=17>"3817 HOME DEPOT</TD><TD class=xl24 style="BORDER-RIGHT: #d4d0c8; BORDER-TOP: #d4d0c8; BORDER-LEFT: #d4d0c8; WIDTH: 53pt; BORDER-BOTTOM: #d4d0c8; BACKGROUND-COLOR: transparent" width=71> INC"</TD></TR></TBODY></TABLE>

<TABLE style="WIDTH: 302pt; BORDER-COLLAPSE: collapse" cellSpacing=0 cellPadding=0 width=403 border=0 x:str><COLGROUP><COL style="WIDTH: 249pt; mso-width-source: userset; mso-width-alt: 12141" width=332><COL style="WIDTH: 53pt; mso-width-source: userset; mso-width-alt: 2596" width=71><TBODY><TR style="HEIGHT: 12.75pt" height=17><TD style="BORDER-RIGHT: #d4d0c8; BORDER-TOP: #d4d0c8; BORDER-LEFT: #d4d0c8; WIDTH: 249pt; BORDER-BOTTOM: #d4d0c8; HEIGHT: 12.75pt; BACKGROUND-COLOR: transparent" width=332 height=17></TD><TD class=xl24 style="BORDER-RIGHT: #d4d0c8; BORDER-TOP: #d4d0c8; BORDER-LEFT: #d4d0c8; WIDTH: 53pt; BORDER-BOTTOM: #d4d0c8; BACKGROUND-COLOR: transparent" width=71>

</TD></TR></TBODY></TABLE>
 
Upvote 0
How exactly are you doing the importing part?

That's a lot of code for what should probably be a simple job, mind you I've not seen the data and I'm not sure exactly what the code is doing.

Can't you just simply open the file using File>Open... and selecting it?

If it is a CSV file then that should either open it automatically start up the text file import wizard which you could use to import the file 'correctly'.

To get the code for that you could turn on the macro recorder when you do it manually.

Another option could try Data>Get external data...Import Text File..., which again you could record.
 
Upvote 0
yes, i could record the data import process but I need to ask the user for the file name and location (as it could be different everytime) and also it needs to import into a pre-named sheet.

the code that I have does those things and I'm not sure how to modify the data import process macro to do those.
 
Upvote 0
1 Use Application GetOpenFilename to allow the user to specify the file, which could also help eliminate problems with the filename.

2 That shouldn't be a problem, if you are using the Data>Import External Data... then you can specify the sheet and range where the data goes.

If you do record a macro to geet code then it's almost inevitable that you would need to change them to suit but that wouldn't be too hard.

It seems to me that all that code is way to do something as simple as importing a file.

I know the code is probably doing more than that but it might be worth looking at the importing code and getting it 'right'

Then start on the rest of code for whatever else it's meant to do.:)
 
Upvote 0
ok, I added a way to get the file name (I think).
but I get an error when it goes to add 'With ActiveSheet......' part of the code.

I get the 'destination range is not on the same worksheet that the query table is being created on'.

I run the macro from a 'forms' sheet, it goes out get the external data and puts in onto the "Paste Spcl Values from 45-2 Rpt" worksheet (all in the same workbook)

I may have the code wrong in the 'with active sheet...?


Application.CutCopyMode = False

FileToOpen = Application _
.GetOpenFilename("Text Files (*.csv), *.csv")
If FileToOpen <> False Then
MsgBox "Open " & FileToOpen
End If

With ActiveSheet.QueryTables.Add(Connection:= _
FileToOpen, Destination:= _
Sheets("Paste Spcl Values from 45-2 Rpt").Range("A1"))


.Name = "ExternalData_1"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 437
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = True
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, _
1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
'Sheets("Paste Spcl Values from 45-2 Rpt").Select
End Sub
 
Upvote 0
Well one thing you should try not using is ActiveSheet.

Also what workbook is the sheet 'Paste Spcl Values from 45-2 Rpt'.

You would probably also need to use Workbooks.Open to open the CSV file - GetOpenFileName doees what it says.

ie get's the filename, it doesn't open the file.:)

Mind you when I think about it that shouldn't be a problem if you are using Data>Get External Data...

I've looked through your code a no of times, not all of it obviously, but it's really hard to follow.

Perhaps if you explained, in words, what you are trying to do it might help.:)
 
Upvote 0
1) Change your source file extension from .csv to .txt.
2) Instead of "Get External Data", turn on the macro recorder, and just have it on while you open a .txt file.

I use the following macro to open a tab file (when finished, it sets the newly opened file to the wbDataSource variable that has module scope, so I can use it in the next sub). Its not what you need but maybe shows that this can be a heck of a lot simpler as far as code goes. The original code would have been recorded with the macro recorder - then I just add the getopenfilename bit (mentioned by Norie) and tweak a little to use the filename from the user.

Code:
Sub GetOpenFileNameForInputData()
Dim varFileName As Variant

varFileName = Application.GetOpenFilename(Title:="Select a File to Import")

If varFileName = False Or varFileName = "" Then
    End

Else
    Workbooks.OpenText Filename:= _
    varFileName, Origin:= _
    437, StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
    ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, Comma:=False _
    , Space:=False, Other:=False, FieldInfo:=Array(Array(1, 1), Array(2, 1), _
    Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1), Array(8, 1), Array(9, 1), _
    Array(10, 1)), TrailingMinusNumbers:=True
End If

Set wbDataSource = ActiveWorkbook

End Sub

---------------

Although, that said, I see you've recorded a query - why not just save the file in a special folder dedicated to the "csv source file", and then just refresh the query in the workbook where you need the data? That way, whenever you've put a fresh file in the folder, you only need to click a button in Excel (Refresh Data).
 
Last edited:
Upvote 0

Forum statistics

Threads
1,215,250
Messages
6,123,887
Members
449,130
Latest member
lolasmith

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top