How to rename the .XL file which in coverted from .CSV

[Jagdev Singh]

Hi Experts

Refering to the thread - http://forum.chandoo.org/threads/csv-file-not-opening-proper-in-excel.23043/#post-139463 where we have a code which convert the .CSV file to .XL file. I am converting one file at a time with this code. Is it possible to rename the Excel file with the name of its .CSV file which we convert with this code. I tried many ways and search a lot on google, but failed to acheive this. Please let me know if this is possible or not.

Regards,
JD

 

[Luke M]

Hi Jagdev,

In the code, after transferring info to the sheet and before incrementing fileNum, put this line:

ActiveWorkbook.SaveAs Filename:=Replace(selectedFile, ".csv", ".xlsx"), FileFormat:=xlWorkbookDefault

so the full code then is

Sub VishalCsvInput()
   Dim dim1 As Integer, dim2 As Integer, fileNum As Integer
   Dim delim As String, element As String
   Dim strCSV As String
   Dim fd As FileDialog
   Dim initArray As Variant, finArray As Variant, selectedFile As Variant
   Dim Idx1 As Long, Idx2 As Long
   Set fd = Application.FileDialog(msoFileDialogFilePicker)
   fileNum = 1
   delim = InputBox(Prompt:="Delimiter Selection", Title:="Please enter your required delimiter", Default:=",")
   With fd
       If .Show = -1 Then
           For Each selectedFile In .SelectedItems
                strCSV = ImportTextFile(selectedFile)
                initArray = Split(strCSV, vbCrLf)
                dim1 = UBound(initArray)
                dim2 = UBound(Split(initArray(0), delim))
               ReDim finArray(dim1, dim2)
               For Idx1 = LBound(initArray) To UBound(initArray) - 1
                   For Idx2 = 0 To dim2
                        element = Split(initArray(Idx1), delim)(Idx2)
                        finArray(Idx1, Idx2) = Replace(element, "'", "")
                   Next
               Next
                Sheets("Sheet1").Range("A" & fileNum).Resize(UBound(finArray), UBound(Application.Transpose(finArray))) = finArray
                ActiveWorkbook.SaveAs Filename:=Replace(selectedFile, ".csv", ".xlsx"), FileFormat:=xlWorkbookDefault
                fileNum = fileNum + 100
           Next selectedFile
       End If
   End With
End Sub

Function ImportTextFile(strFile As Variant) As String
   Open strFile For Input As #1
    ImportTextFile = Input$(LOF(1), 1)
   Close #1
End Function

 

[Jagdev Singh]

Hi Luke

The code work liks a charm.

Is it possible with the current set of code to rename all the .CSV files to .XL and rename it on a click. In the current scenerio it everytime ask for a single file to select, perform the conversion and rename.

Regards,
JD

 

[Luke M]

Try this

Sub VishalCsvInput()
   Dim dim1 As Integer, dim2 As Integer, fileNum As Integer
   Dim delim As String, element As String
   Dim strCSV As String
   Dim fd As FileDialog
   Dim initArray As Variant, finArray As Variant, selectedFile As Variant
   Dim Idx1 As Long, Idx2 As Long
   Dim newWB As Workbook
   Set fd = Application.FileDialog(msoFileDialogFilePicker)
   fileNum = 1
   delim = InputBox(Prompt:="Delimiter Selection", Title:="Please enter your required delimiter", Default:=",")
   Application.ScreenUpdating = False
   With fd
       If .Show = -1 Then
           For Each selectedFile In .SelectedItems
                Set newWB = Workbooks.Add
                strCSV = ImportTextFile(selectedFile)
                initArray = Split(strCSV, vbCrLf)
                dim1 = UBound(initArray)
                dim2 = UBound(Split(initArray(0), delim))
               ReDim finArray(dim1, dim2)
               For Idx1 = LBound(initArray) To UBound(initArray) - 1
                   For Idx2 = 0 To dim2
                        element = Split(initArray(Idx1), delim)(Idx2)
                        finArray(Idx1, Idx2) = Replace(element, "'", "")
                   Next
               Next
                newWB.Sheets("Sheet1").Range("A" & fileNum).Resize(UBound(finArray), UBound(Application.Transpose(finArray))) = finArray
                newWB.SaveAs Filename:=Replace(selectedFile, ".csv", ".xlsx"), FileFormat:=xlWorkbookDefault
                fileNum = fileNum + 100
                newWB.Close
           Next selectedFile
       End If
   End With
   Application.ScreenUpdating = True
End Sub

Function ImportTextFile(strFile As Variant) As String
   Open strFile For Input As #1
    ImportTextFile = Input$(LOF(1), 1)
   Close #1
End Function

When the file picker dialogue opens, you can select multiple files by holding down Ctrl. Macro will create a new workbooks for each file you select.

 

[Jagdev Singh]

Hi Luke

The code is working fine, but it keeps on throwing a pop-up msg that the same named file is exist in the folder.

Regards,
JD

 

[Luke M]

Change this:

newWB.SaveAs Filename:=Replace(selectedFile, ".csv", ".xlsx"), FileFormat:=xlWorkbookDefault

to this:

Application.DisplayAlerts = False
newWB.SaveAs Filename:=Replace(selectedFile, ".csv", ".xlsx"), FileFormat:=xlWorkbookDefault
Application.DisplayAlerts = True

 

[Jagdev Singh]

Hi Luke

The code is working fine, but it was throwing a pop-up msg stating do you want to save the changes.

I added one more line
ActiveWorkbook.save

After the below code and it did the treak

Application.DisplayAlerts = False
newWB.SaveAs Filename:=Replace(selectedFile, ".csv", ".xlsx"), FileFormat:=xlWorkbookDefault
Application.DisplayAlerts = True

Thanks for providing your help on it.

Regards,
JD