J
John V
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 here:
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
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 here:
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