The following program opens a CSV file with 30 or so columns and trims it down to 6 columns of data and then saves the new file in another folder. I'm trying to save the file as a CSV file but it doesn't seem to be saving as a CSV - some data is getting lost but I don't know what part. When I go to open the new file and read it with VBA it's not reading correctly.
I've tried building a file manually by trimming the unwanted columns and then saving but I get a warning popup about how some info will be lost. Some info is certainly getting lost? Any ideas?
I haven't used this program since 2011 but it used to work back then. Has something changed in the last couple of years that could be causing the problem?
I've tried building a file manually by trimming the unwanted columns and then saving but I get a warning popup about how some info will be lost. Some info is certainly getting lost? Any ideas?
I haven't used this program since 2011 but it used to work back then. Has something changed in the last couple of years that could be causing the problem?
Code:
Option Explicit
Private Sub CommandButton1_Click()
Dim I As Long
For I = 2 To 4 '1017
ProcessCSV Sheet9.Range("A" & I).Value
Next I
End Sub
Private Sub ProcessCSV(FileNameCell As String)
' --> User settings, change to suit
Const FileNameExt = "CSV"
' External data file extention
'Const FileFolder = "C:\Solar\Data\TMY3"
' Folder with external data files
Const LinesDelim = vbLf
' Lines delimiter of CSV file
Const DestSheet = "Data"
' Destination sheet name
'Const ImportedColumns = "C,D,E,H,AF,AU"
' Columns to be imported"
Const ImportedColumns = "C,D,E,H,AF,AU"
' Columns to be imported"
' <-- End of User settings
Dim FileName$, r&, I&, x
Dim wbCSV As Workbook
Dim wbNew As Workbook
Dim wbThis As Workbook
' Freeze on screen, events, calculations (speeding up)
With Application
.ScreenUpdating = False
.EnableEvents = False
.Calculation = xlCalculationManual
End With
Set wbThis = ThisWorkbook
Sheets(DestSheet).UsedRange.ClearContents
FileName = "C:\Solar\Data\TMY3\" & FileNameCell & "." & FileNameExt
If Dir(FileName) <> "" Then
Set wbCSV = Workbooks.Open(FileName)
' Delete all columns but ImportedColumns
With wbCSV.Sheets(1)
For Each x In Split(ImportedColumns, ",")
I = I + 1
.Columns(x).Copy Destination:=wbThis.Worksheets("Data2").Columns(I)
Next
End With
wbCSV.Close
Application.DisplayAlerts = False
wbThis.Sheets("Data2").Copy
Set wbNew = ActiveWorkbook
Sheets("Data2").Rows("1:2").Select
Selection.Delete Shift:=xlUp
wbNew.SaveAs FileName:="C:\Solar\Data\TMY\" & FileNameCell & "." & FileNameExt, FileFormat:=xlCSV, _
CreateBackup:=False
wbNew.Close
End If
' Unfreeze screen, events, calculations
With Application
.Calculation = xlCalculationAutomatic
.CutCopyMode = False
.DisplayAlerts = True
.EnableEvents = True
.ScreenUpdating = True
End With
End Sub