Quick convert Excel->CSV

mikekiwi · #1 (**permalink**) 01-28-05, 09:52

Hi,

At the office I have to convert lots of excel-files (50 or 60 a day) to csv-format (semicolon separated). No additional formatting has to be done, only a straight-forward save-as-csv.

Is there a tool which can help me out in finding a way to do this a lot quicker than the regular opening in Excel and then do save-as-csv with all the dialog-boxes?

The most convenient way would be a right-mouse-click in the Windows Explorer and then have the option "convert-to csv", but any other way which is faster than the current way is interesting...

Does anybody has a good idea about this?

Thanks for your time,
Michael

DavidCoutts · #2 (**permalink**) 01-28-05, 10:16

how about using a macro

Code:

Sub SveAsCSV()
    Dim myfiles As Variant, fl As Variant
    Dim fl2 As String
    
    Application.DisplayAlerts = False
    
    myfiles = Application.GetOpenFilename(MultiSelect:=True)
    
    
    If IsArray(myfiles) Then
        For Each fl In myfiles
            Workbooks.Open fl
            fl2 = Mid(fl, InStrRev(fl, "\") + 1, Len(fl) - InStrRev(fl, "\") + 1)
            fl2 = Mid(fl2, 1, Len(fl2) - 4)
            Workbooks(fl2).SaveAs fl, xlCSV
            Workbooks(fl2).Close
        Next fl
    Else
        Workbooks.Open fl
        Workbooks(fl).SaveAs fl, xlCSV
        Workbooks(fl).Close
    End If
    
    Application.DisplayAlerts = True
End Sub

it should do the job for you by using multiselect in an open box

HTH
Dave

Teddy · #3 (**permalink**) 01-28-05, 10:41

Nice, clean code there Dave!

DavidCoutts · #4 (**permalink**) 01-28-05, 10:50

its by no means complete but it should function smoothly if used exactly right, rammed it together in about 5 mins, i would of added comments but the code barley needs it, ive spotted a couple of mistakes already but never mind

mikekiwi · #5 (**permalink**) 02-02-05, 02:46

Quote:

Originally Posted by DavidCoutts

its by no means complete but it should function smoothly if used exactly right, rammed it together in about 5 mins, i would of added comments but the code barley needs it, ive spotted a couple of mistakes already but never mind

Hi David,

thanks a lot for the effort, I tried it this morning (was not in the office for a few days), but unfortunately got an error while running the macro ("Subscript out of Range") ; according to the debugger this line causes the error:

Code:

Workbooks(fl2).SaveAs fl, xlCSV

As I'm not really an expert in VBA (understatement), I can't find the solution by myself. Thanks for helping me out!

DavidCoutts · #6 (**permalink**) 02-03-05, 06:43

Hi mikekiwi,

sorry about the delay but ive been out sick for a couple of days
ok have sorted this code out for you, and have added some extra functionality to it,

Code:

Sub SveAsCSV()
    'open and save a group of workbooks as CSV Format
    Dim myfiles As Variant, fl As Variant
    Dim fl2 As String
    Dim flOut As String, flOut2 As String
    Dim sveLocn As String
    Dim bolFirst As Boolean
    Dim msgReturn As VbMsgBoxResult
    
    'set the warnings to false
    Application.DisplayAlerts = False
    
    'open the file dialog and obtain names to run
    myfiles = Application.GetOpenFilename(MultiSelect:=True)
    
    
    'check to see if any entries are valid
    If IsArray(myfiles) Then
        'set first run to be true
        bolFirst = True
        For Each fl In myfiles
            'open the workbook in the array
            Workbooks.Open fl
            'set up the name of the workbook from name and filepath
            fl2 = Mid$(fl, InStrRev(fl, "\") + 1, Len(fl) - InStrRev(fl, "\") + 1)
            fl2 = Mid$(fl2, 1, Len(fl2) - 4)
            'generate a save location on first run through
            If bolFirst = True Then
                sveLocn = Application.GetSaveAsFilename(fl2, , , "Save Location")
                If Not sveLocn = "False" Then
                    sveLocn = Mid$(sveLocn, 1, InStrRev(sveLocn, "\"))
                Else
                    'save location set to open location
                    msgReturn = MsgBox("Do you want to save to the open Location" & Chr$(10) & _
                                        "Click no to exit Program", vbYesNo, "Save to Same Location")
                    
                    ' on no click exit program
                    If msgReturn = vbNo Then Exit Sub
                    'else set to the open location
                    sveLocn = Mid$(fl, 1, InStrRev(fl, "\"))
                End If
            'set the save location to false to only run this portion once
            bolFirst = False
                
            End If
            'create an output name & path
            flOut = sveLocn & fl2 & ".csv"
            
            'save and close the workbook
            Workbooks(fl2).SaveAs flOut, xlCSV
            Workbooks(fl2).Close
        Next fl
    Else
    
        'display a message if cancel button selected
        MsgBox "No File Selected" & Chr$(10) & "Exiting Program", vbOKOnly, "No Selection"
        Exit Sub
    End If
    
    'display a message to display that the process has completed
    MsgBox "Proccess Finished" & Chr$(10) & Chr$(10) & _
            UBound(myfiles) & " files written to " & Chr$(10) & Chr$(10) & _
            sveLocn, _
            vbOKOnly, "Process Finished"
                
    
    'set alerts back on
    Application.DisplayAlerts = True
    Exit Sub
ErrorHandler:
    'display any errors that occur
    
End Sub

What you should now do is add this to a button on your worksheet and add comments to the sheet to explain whats going on

All the best
Dave

mikekiwi · #7 (**permalink**) 02-03-05, 07:52

Thanks for all the effort, Dave! I really appreciate it!

However, I hate to bring the bad news, but again I get a subscript out of range error... in the same line as before:

Code:

Workbooks(fl2).SaveAs flOut, xlCSV

Am I doing something wrong or is there something wrong with my settings?

Cheers,
Michael

DavidCoutts · #8 (**permalink**) 02-03-05, 09:22

Hi Michael

not sure just a thing to test, there are 2 variables in the line fl2 and flOut
if you hover over them what values are you getting

or if you want add the line
debug.print fl2 & " , " & flout to see if there is any problems with this
im wondering if there is a possibility of your file reading without the .xls extension as this would throw the line off

if so try replacing this line

fl2 = Mid$(fl2, 1, Len(fl2) - 4)

with

If InStr(1, fl2, ".") <> 0 Then fl2 = Mid$(fl2, 1, Len(fl2) - 4)

ive tested with Success on xl2000 and xl2002
also check the saveas in your helpfile and make sure that xlCSV is a proper file format as this could generate errors.

but more likely you are generating errors as of the file formats

Quote:

Originally Posted by mikekiwi

Am I doing something wrong or is there something wrong with my settings?

shouldnt matter but if we can find the root of the problem then we can handle it so it will work on various settings of different machines

it might also be interesting to find out what the vaariable fl is picking up

we will get this sorted for you
Dave

mikekiwi · #9 (**permalink**) 02-03-05, 09:54

Thanks Dave, here are my findings:

* Debug-result: shop11 , D:\Data\testxlcsv\shop11.csv

As there's no xls-extension, I've replaced the line as described with:
If InStr(1, fl2, ".") <> 0 Then fl2 = Mid$(fl2, 1, Len(fl2) - 4)

Unfortunately, this does produce the same error as before. No changes...

I've attached the xls in which I created the module; I'm not sure it will help, but maybe you can derive something from it.
By the way: I'm using XL2000, the saveas in the help does mention xlCSV...

DavidCoutts · #10 (**permalink**) 02-03-05, 10:10

im presuming the drive d: is a network drive rather than a cdrom drive
as im pretty sure that this code couldnt write to a cdrom
does the code work when you try to save to your local drive i.e. C:

is your file shop11.xls or shop11 as the workbook name?

ive just tested a couple more times from c:\folders... to k:\folders... as k is the network drive im working with

im just trying to ascertain the problem thats occurring as the variables actually look fine.
Dave

mikekiwi · #11 (**permalink**) 02-03-05, 10:16

Quote:

Originally Posted by DavidCoutts

im presuming the drive d: is a network drive rather than a cdrom drive
as im pretty sure that this code could write to a cdrom
does the code work when you try to save to your local drive i.e. C:

is your file shop11.xls or shop11 as the workbook name?

ive just tested a couple more times from c:\folders... to k:\folders... as k is the network drive im working with

im just trying to ascertain the problem thats occurring as the variables actually look fine.
Dave

Drive D is a second drive in my pc, so no cd-rom.
The Filename = shop11.xls

DavidCoutts · #12 (**permalink**) 02-03-05, 10:24

I wish i could be there with you and wed probably get this fixed in a matter of seconds

if you highlight this line out try it does it work now
If InStr(1, fl2, ".") <> 0 Then fl2 = Mid$(fl2, 1, Len(fl2) - 4)

to highlight out put a single quote in front of the line i.e. '
and see if it works now, i dont know if this will make any difference but it might be worth a try as we will now be trying to save workbooks("shop11.xls") instead of workbooks("shop11")

mikekiwi · #13 (**permalink**) 02-03-05, 10:52

Quote:

Originally Posted by DavidCoutts

I wish i could be there with you and wed probably get this fixed in a matter of seconds

if you highlight this line out try it does it work now
If InStr(1, fl2, ".") <> 0 Then fl2 = Mid$(fl2, 1, Len(fl2) - 4)

to highlight out put a single quote in front of the line i.e. '
and see if it works now, i dont know if this will make any difference but it might be worth a try as we will now be trying to save workbooks("shop11.xls") instead of workbooks("shop11")

Done this and now the file is save but with an odd filename: shop11.xls.csv
It is a csv-file so conversion was ok!, but still got the same error (subscript out of range) but now on the next line (closing the workbook).

DavidCoutts · #14 (**permalink**) 02-03-05, 10:59

Ok it would save as an odd name and not close as below but now that we have figured out why this is easily sorted
1 the file we built up for the csv file contained the fl2 variable i.e shop11.xls
then it trys to close shop11.xls but this is no longer in existance so we need to change this to .csv

ive provided a full listing below which has been sorted

Code:

Sub SveAsCSV()
    'open and save a group of workbooks as CSV Format
    Dim myfiles As Variant, fl As Variant
    Dim fl2 As String
    Dim flOut As String, flOut2 As String
    Dim sveLocn As String
    Dim bolFirst As Boolean
    Dim msgReturn As VbMsgBoxResult
    
    'set the warnings to false
    Application.DisplayAlerts = False
    
    'open the file dialog and obtain names to run
    myfiles = Application.GetOpenFilename(MultiSelect:=True)
    
    
    'check to see if any entries are valid
    If IsArray(myfiles) Then
        'set first run to be true
        bolFirst = True
        For Each fl In myfiles
            'open the workbook in the array
            Workbooks.Open fl
            'set up the name of the workbook from name and filepath
            fl2 = Mid$(fl, InStrRev(fl, "\") + 1, Len(fl) - InStrRev(fl, "\") + 1)
            
            'generate a save location on first run through
            If bolFirst = True Then
                sveLocn = Application.GetSaveAsFilename(fl2, , , "Save Location")
                If Not sveLocn = "False" Then
                    sveLocn = Mid$(sveLocn, 1, InStrRev(sveLocn, "\"))
                Else
                    'save location set to open location
                    msgReturn = MsgBox("Do you want to save to the open Location" & Chr$(10) & _
                                        "Click no to exit Program", vbYesNo, "Save to Same Location")
                    
                    ' on no click exit program
                    If msgReturn = vbNo Then Exit Sub
                    'else set to the open location
                    sveLocn = Mid$(fl, 1, InStrRev(fl, "\"))
                End If
            'set the save location to false to only run this portion once
            bolFirst = False
                
            End If
            'create an output name & path
            flOut = sveLocn & Mid$(fl2, 1, Len(fl2) - 4) & ".csv"
            
            'save and close the workbook
            Workbooks(fl2).SaveAs flOut, xlCSV
            'rename variable to close workbook
            fl2 = Mid$(fl2, 1, Len(fl2) - 4) & ".csv"
            Workbooks(fl2).Close
        Next fl
    Else
    
        'display a message if cancel button selected
        MsgBox "No File Selected" & Chr$(10) & "Exiting Program", vbOKOnly, "No Selection"
        Exit Sub
    End If
    
    'display a message to display that the process has completed
    MsgBox "Proccess Finished" & Chr$(10) & Chr$(10) & _
            UBound(myfiles) & " files written to " & Chr$(10) & Chr$(10) & _
            sveLocn, _
            vbOKOnly, "Process Finished"
                
    
    'set alerts back on
    Application.DisplayAlerts = True
    Exit Sub
ErrorHandler:
    'display any errors that occur
    MsgBox Err.Number & ":   " & Err.Description
End Sub

All the best
Dave

mikekiwi · #15 (**permalink**) 02-04-05, 02:22

Thanks Dave!!! This version works great !!! No errors, (multiple) files are saved as csv, this is good and definitely saves a lot of time....

Just one question though: in one of the files I've tested I think the " - sign (double quots) was used as text-qualifier; is it possible to disable this for any of the fileds in the output?

Thanks a lot Dave, you've been of great help!

Internet Services

Web Development

Digital Marketing

Consumer Tech