CSV Import Issues (Newbie)
Hi John,
Worked ok for me, except if single quote or none is selected as text
qualifier.
What if you open manually (rename extention to .txt)
Is the text qualifier double quote selected by default ?
For the opentext method , it is the default (").
I don't think it is related to the regional settings ...
Regards
JY
"John V" wrote in message
...
The routine below is used to import the contents of several files and
paste
those contents into a worksheet. All worked fine until the source files
changed from tab delimited to CSV (nothing I can do about the change).
I changed two lines of code to recognize .csv file instead of a .txt file,
then imported.
The resulting destination worksheet has unexpected results. 1) All text
cells are now preceeded by a single quote, and 2) any commas embedded in a
text source cell cause the text to be parsed into two or more destination
cells. (Example, here is part of a CSV file:
POOR,"Have nothing good to say, and blah blah", A, B
This gets parsed into five columns, with "Have nothing good to say" in one
column and "and blah blah" in another. I expected four columns.
Any help much appreciated.
John
Code starts he
Sub Firstattempt()
Dim rng, rng1 As Range
Dim FNames(1 To 100, 1 To 2) As Variant
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim FN As String ' For File Name
Dim ThisRow As Long
Dim MyFileLocation As String
MyFileLocation = ThisWorkbook.Path & "\*.csv"
' Changed from Tab to Comma delimited 9/06
FN = Dir(MyFileLocation)
FNum = 0
Do Until FN = ""
FNum = FNum + 1
Workbooks.OpenText Filename:=ThisWorkbook.Path & "\" & FN, _
DataType:=xlDelimited, Comma:=True
' Changed from Tab to Comma delimited 9/06
ActiveCell.CurrentRegion.Copy
Workbooks(FN).Close SaveChanges:=False
Worksheets("Raw Data").Activate
Set rng = Worksheets("Raw Data").Cells(Rows.Count, 1).End(xlUp)(2)
Set rng1 = rng.Offset(1, 0)
If FNum = 1 Then
Set rng = Range("A1")
Set rng1 = Range("a2")
End If
'Range("myRange").Columns(1).Value = 0
rng.Activate
ActiveCell.PasteSpecial
If FNum < 1 Then
rng.Activate
ActiveCell.EntireRow.Delete
End If
rng1.Activate
FNames(FNum, 1) = Left(FN, Len(FN) - 4)
Do While True
If ActiveCell = "" Then Exit Do
ActiveCell.Value = FNames(FNum, 1)
ActiveCell.Offset(1, 0).Activate
FNames(FNum, 2) = FNames(FNum, 2) + 1
Loop
FN = Dir
Loop
Worksheets("Files Imported").Activate
Range("a1:b" & FNum).Value = FNames
Application.ScreenUpdating = True
End Sub
|