• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

convert multiple csv to xlsx files and save as same filename

J

jk51

Member
Hi,

Help please. I want to create a macro converting 20 csv files to xlsx format and keep the same filenames in the same directory.

1) Input: Open and Browse the folder name directory containing csv files. click ok
2) Process: convert csv files to xlsx files and save the same filename as previous csv files no matter it is long name (max characters up to 70), some space between characters
3) Output: save all xlsx; same filenames as previous in the same directory.

Thank you.

Mr Singh
 
Try...
Code: 
Sub Demo()
    Dim mydir As String
    With Application.FileDialog(msoFileDialogFolderPicker)
        .AllowMultiSelect = False
        If .Show Then mydir = .SelectedItems(1) & "\"
        If mydir = vbNullString Then Exit Sub
        SaveAsCsv (mydir)
    End With
End Sub

Sub SaveAsCsv(ByVal mydir As String)
    Dim fso As Object, myFile As Object, myWb As Workbook
    Set fso = CreateObject("Scripting.FileSystemObject")
    For Each myFile In fso.GetFolder(mydir).Files
        If InStr(1, myFile.Name, ".csv") > 1 Then
            Workbooks.OpenText mydir & myFile.Name, , , xlDelimited, , , , , True, , , , , , , , , False
            Set myWb = ActiveWorkbook
            myWb.SaveAs Filename:=mydir & Replace(myFile.Name, ".csv", ".xlsx"), FileFormat:=xlOpenXMLWorkbook
            myWb.Close False
        End If
    Next
End Sub
 
Last edited:
Hi Chihiro,

Thank you very much. Yes it is working.
1) is it possible add further code to overwrite the file conversion if run again? Ask to replace. I want it automatically to replace it.
2) is it possible when run the macro not open csv files, but only convert csv files in one go to save me time?

Best,

Mr Singh
 
1) Just disable Application.DisplayAlerts at start and then enable it at the end.

2) It will require very different coding logic. Or if you don't want to see the file, just turn off Application.ScreenUpdating like 1).
 
Can you check the code for question 1:-

Sub Demo()
Application.DisplayAlerts = False
Dim mydir AsString
With Application.FileDialog(msoFileDialogFolderPicker)
.AllowMultiSelect = False
If .Show Then mydir = .SelectedItems(1) & "\"
If mydir = vbNullString ThenExitSub
SaveAsCsv (mydir)
EndWith
EndSub

Sub SaveAsCsv(ByVal mydir AsString)
Dim fso AsObject, myFile AsObject, myWb As Workbook
Set fso = CreateObject("Scripting.FileSystemObject")
ForEach myFile In fso.GetFolder(mydir).Files
If InStr(1, myFile.Name, ".csv") > 1 Then
Workbooks.OpenText mydir & myFile.Name, , , xlDelimited, , , , , True, , , , , , , , , False
Set myWb = ActiveWorkbook
myWb.SaveAs Filename:=mydir & Replace(myFile.Name, ".csv", ".xlsx"), FileFormat:=xlOpenXMLWorkbook
myWb.CloseFalse
EndIf
Next
Application.DisplayAlerts = True
EndSub
 
Both should go in between "Sub Demo()... End Sub" not in SaveAsCSV sub.

Also, use code tag to post codes.
upload_2017-8-4_11-11-29.png
 
Code: 
Sub Demo()
Application.DisplayAlerts = False
Dim mydir AsString
With Application.FileDialog(msoFileDialogFolderPicker)
.AllowMultiSelect = False
If .Show Then mydir = .SelectedItems(1) & "\"
If mydir = vbNullString ThenExitSub
SaveAsCsv (mydir)
EndWith
Application.DisplayAlerts = True
EndSub

Sub SaveAsCsv(ByVal mydir AsString)
Dim fso AsObject, myFile AsObject, myWb As Workbook
Set fso = CreateObject("Scripting.FileSystemObject")
ForEach myFile In fso.GetFolder(mydir).Files
If InStr(1, myFile.Name, ".csv") > 1 Then
Workbooks.OpenText mydir & myFile.Name, , , xlDelimited, , , , , True, , , , , , , , , False
Set myWb = ActiveWorkbook
myWb.SaveAs Filename:=mydir & Replace(myFile.Name, ".csv", ".xlsx"), FileFormat:=xlOpenXMLWorkbook
myWb.CloseFalse
EndIf
Next
EndSub
 
You then add Application.ScreenUpdating line just below each of Application.DisplayAlerts.

FYI - you are missing the space at "End With"

To clarify further for 2), you can leverage ADO. But, there are many quirks that you need to be aware of and is considerably more complex than above code. I don't recommend it, unless there's reason why the file must remain closed.
 
Code: 
Sub Demo()
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Dim mydir AsString
With Application.FileDialog(msoFileDialogFolderPicker)
.AllowMultiSelect = False
If .Show Then mydir = .SelectedItems(1) & "\"
If mydir = vbNullString ThenExitSub
SaveAsCsv (mydir)
End With
Application.DisplayAlerts = True
Application.ScreenUpdating = False
EndSub

Sub SaveAsCsv(ByVal mydir AsString)
Dim fso AsObject, myFile AsObject, myWb As Workbook
Set fso = CreateObject("Scripting.FileSystemObject")
ForEach myFile In fso.GetFolder(mydir).Files
If InStr(1, myFile.Name, ".csv") > 1 Then
Workbooks.OpenText mydir & myFile.Name, , , xlDelimited, , , , , True, , , , , , , , , False
Set myWb = ActiveWorkbook
myWb.SaveAs Filename:=mydir & Replace(myFile.Name, ".csv", ".xlsx"), FileFormat:=xlOpenXMLWorkbook
myWb.CloseFalse
EndIf
Next
EndSub
 
Code: 
Sub Demo()
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Dim mydir AsString
With Application.FileDialog(msoFileDialogFolderPicker)
.AllowMultiSelect = False
If .Show Then mydir = .SelectedItems(1) & "\"
If mydir = vbNullString ThenExitSub
SaveAsCsv (mydir)
End With
Application.DisplayAlerts = True
Application.ScreenUpdating = True
EndSub

Sub SaveAsCsv(ByVal mydir AsString)
Dim fso AsObject, myFile AsObject, myWb As Workbook
Set fso = CreateObject("Scripting.FileSystemObject")
ForEach myFile In fso.GetFolder(mydir).Files
If InStr(1, myFile.Name, ".csv") > 1 Then
Workbooks.OpenText mydir & myFile.Name, , , xlDelimited, , , , , True, , , , , , , , , False
Set myWb = ActiveWorkbook
myWb.SaveAs Filename:=mydir & Replace(myFile.Name, ".csv", ".xlsx"), FileFormat:=xlOpenXMLWorkbook
myWb.CloseFalse
EndIf
Next
EndSub
 
Code: 
Sub Demo()
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Dim mydir AsString
With Application.FileDialog(msoFileDialogFolderPicker)
.AllowMultiSelect = False
If .Show Then mydir = .SelectedItems(1) & "\"
If mydir = vbNullString ThenExitSub
SaveAsCsv (mydir)
End With
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

Sub SaveAsCsv(ByVal mydir AsString)
Dim fso AsObject, myFile AsObject, myWb As Workbook
Set fso = CreateObject("Scripting.FileSystemObject")
ForEach myFile In fso.GetFolder(mydir).Files
If InStr(1, myFile.Name, ".csv") > 1 Then
Workbooks.OpenText mydir & myFile.Name, , , xlDelimited, , , , , True, , , , , , , , , False
Set myWb = ActiveWorkbook
myWb.SaveAs Filename:=mydir & Replace(myFile.Name, ".csv", ".xlsx"), FileFormat:=xlOpenXMLWorkbook
myWb.CloseFalse
End If
Next
End Sub
 
You must log in or register to reply here.
Back
Top