Solved: CSV to ASCII

[ask7779]

Hello,

I am newbie in writing macro and so far, I am able to download the data from internet in zip file. I am also able to unzip this file. This file is in CSV format. I want to read this CSV file, choose specific columns and write these data in text file.

Attaching sample file here.

Can someone please help me with this?

Thanks.
- Sandeep

[Tinbendr]

Turn Macro On

Open CSV file.

Delete unwanted columns.

Save as Tabbed-Delimited text file.

Turn macro recorder off.

Lookup GetOpenFileName and implement that code to the recorded one.

[ask7779]

Hi Tinbendr,

Thank you for your prompt reply.

I followed the steps you suggested and got the code from recorded macro. I am not able to open my file via program as well as it is failing for activating the file. Not sure what has gone wrong. Here is the complete code

[VBA]Option Explicit
'Declarations
Private Declare Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA" (ByVal pCaller As Long, ByVal szURL As String, ByVal szFileName As String, ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long

'Download Code
Sub download()

Dim done
Dim unzipdone
Dim filename
Dim filename1
Dim szfromdate As String
Dim szfromdate1 As String
Dim sztodate As String
Dim fromdate As Date
Dim todate As Date
Dim i As Date
Dim szDay As String
Dim vFile As String

fromdate = "01-Sep-2010"
todate = "30-Sep-2010"

For i = fromdate To todate
szfromdate = Format(i, "ddmmyy")
szfromdate1 = Format(i, "yyyymmdd")
filename = "eq" + szfromdate + "_csv.zip"
filename1 = "C:\eq" + szfromdate + "_csv"
szDay = Format(i, "dddd")

If szDay <> "Saturday" And szDay <> "Sunday" Then
' Change AboveURL to http and : and // and www and . and bseindia and . and com and /Hisbhav/
done = URLDownloadToFile(0, "AboveURL" + filename, "C:\" + filename, 0, 0)
unzipdone = Unzip("C:\", "C:\" & filename)
Kill "C:\" + filename

'Added Following code to process csv file and converting to ASCII with required columns
vFile = Application.GetOpenFilename(filefilter:="CSV Files (*.csv), " + filename1)

Windows(filename1).Activate
ActiveCell.Offset(0, 2).Columns("A:B").EntireColumn.Select
Selection.Delete Shift:=xlToLeft
ActiveCell.Offset(0, 4).Columns("A:C").EntireColumn.Select
Selection.Delete Shift:=xlToLeft
ActiveCell.Offset(0, 1).Columns("A:B").EntireColumn.Select
Selection.Delete Shift:=xlToLeft
ActiveCell.Offset(0, -5).Columns("A:A").EntireColumn.Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
ActiveCell.Select
ActiveCell.FormulaR1C1 = "Date"
ActiveCell.Offset(1, 0).Range("A1").Select
ActiveCell.FormulaR1C1 = szfromdate1
ActiveCell.Select
Selection.AutoFill Destination:=ActiveCell.Range("A1:A3106")
ActiveCell.Range("A1:A3106").Select
ActiveCell.Offset(-1, 0).Rows("1:1").EntireRow.Select
Selection.Delete Shift:=xlUp
ActiveWorkbook.SaveAs filename:="C:\EQ010910.txt", FileFormat:= _
xlCSVMSDOS, CreateBackup:=False
ActiveWorkbook.Save
ActiveWindow.Close

End If
Next i

'Test.
If done = 0 Then
MsgBox "File has been downloaded!"
Else
MsgBox "File not found!"
End If


End Sub


Public Function Zipp(ZipName, FileToZip)
'Zips A File
'ZipName must be FULL Path\Filename.zip - name Zip File to Create OR ADD To
'FileToZip must be Full Path\Filename.xls - Name of file you want to zip
Dim FSO As Object
Dim oApp As Object
If Dir(ZipName) = "" Then
Open ZipName For Output As #1
Print #1, Chr$(80) & Chr$(75) & Chr$(5) & Chr$(6) & String(18, 0)
Close #1
End If
Set oApp = CreateObject("Shell.Application")
oApp.Namespace(ZipName).CopyHere (FileToZip)
'Keep script waiting until Compressing is done
On Error Resume Next
Do Until oApp.Namespace(ZipName).items.Count = 1
Application.Wait (Now + TimeValue("0:00:01"))
Loop
On Error GoTo 0
On Error Resume Next
Set FSO = CreateObject("scripting.filesystemobject")
FSO.deletefolder Environ("Temp") & "\Temporary Directory*", True
Set oApp = Nothing
Set FSO = Nothing
End Function

Public Function Unzip(DefPath, Fname)
'Unzips A File
'Fname must be FULL Path\Filename.zip
'DefPath must be valid Path you want to Unzip file TO
'You just need to pass 2 strings.
'C:\FullPath\Filename.zip - the file to UNZIP
'C:\FullPath\ - folder to unzip to
Dim FSO As Object
Dim oApp As Object
Set oApp = CreateObject("Shell.Application")
oApp.Namespace(DefPath).CopyHere oApp.Namespace(Fname).items
On Error Resume Next
Set FSO = CreateObject("scripting.filesystemobject")
FSO.deletefolder Environ("Temp") & "\Temporary Directory*", True
Set oApp = Nothing
Set FSO = Nothing
End Function[/VBA]

[Tinbendr]

I recognize the zip routine from your other question. It would have been nice to know that up front.

I'm still not exactly sure which columns, rows you are deleting, but I think it was A:D and Row 1.

try to implement this.

Add [vba]Dim CSVFile as Workbook[/vba]to top of routine. We need to keep a handle on which is the activeworkbook. (IMHO that should be the one that has the code.) and the CSV file which will only contain the data.

(Also, use "&" when concatenating strings and "+" when using math. It works but is not good programming practice.)

I would also use the Code workbook as a log file so when your loops runs, you can track which ones were completed. But that can come later.

[vba]'Added Following code to process csv file and converting to ASCII with required columns
vFile = Application.GetOpenFilename(filefilter:="CSV Files (*.csv), " & filename1)

Set CSVFile = Workbooks.Open(vFile)
CSVFile.Worksheets(1).Columns("A:D").Delete Shift:=xlToLeft
CSVFile.Worksheets(1).Rows("1:1").Delete Shift:=xlUp

CSVFile.SaveAs filename:=filename1 & ".txt", FileFormat:= _
xlCSVMSDOS, CreateBackup:=False
CSVFile.Close[/vba]

David

[ask7779]

Hello Tinbendr,

Thanks again for your help on this thread.

GetOpenFileName function is asking for file name via dialog box. Is it possible to pass the file name programmatically? I have filename1 variable which has filename defined with full path.

Thanks in advance.

Regards,
- Sandeep

[ask7779]

Hello Tinbendr,

I got the solution of suppressing dialog box. I am calling the file directly from your code i.e.
Set CSVFile = Workbooks.Open(filename1)

Last problem what I am facing is - it asks to save the txt file which I am saving it as "SAVE AS". I want to suppress that message. Any help please?

Thanks.
- Sandeep

[ask7779]

Hello Tinbendr,

Problem is resolved by using

CSVFile.close False

Thanks a million for all your help.

Best Regards,
- Sandeep

[ask7779]

Here is the complete code....

Option Explicit
'Declarations
Private Declare Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA" (ByVal pCaller As Long, ByVal szURL As String, ByVal szFileName As String, ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long

'Download Code
Sub download()

Dim done
Dim unzipdone
Dim filename
Dim filename1
Dim szfromdate As String
Dim szfromdate1 As String
Dim sztodate As String
Dim fromdate As Date
Dim todate As Date
Dim i As Date
Dim szDay As String
Dim vFile As String
Dim CSVFile As Workbook
Dim CSVTxtFile As Workbook

fromdate = "22-Nov-2010"
todate = "22-Nov-2010"

For i = fromdate To todate
szfromdate = Format(i, "ddmmyy")
szfromdate1 = Format(i, "yyyymmdd")
filename = "eq" & szfromdate & "_csv.zip"
filename1 = "C:\EQ" & szfromdate & ".CSV"
szDay = Format(i, "dddd")

If szDay <> "Saturday" And szDay <> "Sunday" Then
done = URLDownloadToFile(0, "http://www.bseindia.com/Hisbhav/" + filename, "C:\" + filename, 0, 0)
unzipdone = Unzip("C:\", "C:\" & filename)
Kill "C:\" & filename

'Added Following code to process csv file and converting to ASCII with required columns
'vFile = Application.GetOpenFilename(filefilter:="CSV Files (*.csv), " & filename1)
'MsgBox filename1
'Workbooks.Open filename = filename1
Set CSVFile = Workbooks.Open(filename1)
'Windows(filename1).Activate

ActiveCell.Offset(0, 2).Columns("A:B").EntireColumn.Select
Selection.Delete Shift:=xlToLeft
ActiveCell.Offset(0, 4).Columns("A:C").EntireColumn.Select
Selection.Delete Shift:=xlToLeft
ActiveCell.Offset(0, 1).Columns("A:B").EntireColumn.Select
Selection.Delete Shift:=xlToLeft
ActiveCell.Offset(0, -5).Columns("A:A").EntireColumn.Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
ActiveCell.Select
ActiveCell.FormulaR1C1 = "Date"
ActiveCell.Offset(1, 0).Range("A1").Select
ActiveCell.FormulaR1C1 = szfromdate1
ActiveCell.Select
Selection.AutoFill Destination:=ActiveCell.Range("A1:A3106")
ActiveCell.Range("A1:A3106").Select
ActiveCell.Offset(-1, 0).Rows("1:1").EntireRow.Select
Selection.Delete Shift:=xlUp
CSVFile.Worksheets(1).Columns("A:A").Delete Shift:=xlToLeft
ActiveWorkbook.SaveAs filename:=filename1 & ".txt", FileFormat:= _
xlCSVMSDOS, CreateBackup:=False
'ActiveWorkbook.Close False
'ThisWorkbook.Close savechanges:=True
'ActiveWorkbook.Save
'ActiveWindow.Close
CSVFile.Close False

End If
Next i

'Test.
If done = 0 Then
MsgBox "File has been downloaded!"
Else
MsgBox "File not found!"
End If


End Sub


Public Function Zipp(ZipName, FileToZip)
'Zips A File
'ZipName must be FULL Path\Filename.zip - name Zip File to Create OR ADD To
'FileToZip must be Full Path\Filename.xls - Name of file you want to zip
Dim FSO As Object
Dim oApp As Object
If Dir(ZipName) = "" Then
Open ZipName For Output As #1
Print #1, Chr$(80) & Chr$(75) & Chr$(5) & Chr$(6) & String(18, 0)
Close #1
End If
Set oApp = CreateObject("Shell.Application")
oApp.Namespace(ZipName).CopyHere (FileToZip)
'Keep script waiting until Compressing is done
On Error Resume Next
Do Until oApp.Namespace(ZipName).items.Count = 1
Application.Wait (Now + TimeValue("0:00:01"))
Loop
On Error GoTo 0
On Error Resume Next
Set FSO = CreateObject("scripting.filesystemobject")
FSO.deletefolder Environ("Temp") & "\Temporary Directory*", True
Set oApp = Nothing
Set FSO = Nothing
End Function

Public Function Unzip(DefPath, Fname)
'Unzips A File
'Fname must be FULL Path\Filename.zip
'DefPath must be valid Path you want to Unzip file TO
'You just need to pass 2 strings.
'C:\FullPath\Filename.zip - the file to UNZIP
'C:\FullPath\ - folder to unzip to
Dim FSO As Object
Dim oApp As Object
Set oApp = CreateObject("Shell.Application")
oApp.Namespace(DefPath).CopyHere oApp.Namespace(Fname).items
On Error Resume Next
Set FSO = CreateObject("scripting.filesystemobject")
FSO.deletefolder Environ("Temp") & "\Temporary Directory*", True
Set oApp = Nothing
Set FSO = Nothing
End Function