Convert numerous files in a folder from csv to xls, while carrying out text to columns

15 views Asked by At

I'm trying to convert multiple csv files to xls whilst carrying out a text to column process. I have two macros below. The Text2cols seems to work fine but the ConvertCSVToXls macro seems to have a few issues. Firstly, its really slow. Secondly, it seems to loop through the same csv again and again. I'm running this macro from my personal workbook. Can anyone see the issue? What i would really like would be to sweep the xls files to a subfolder ("filepath\csv files\converted files" and keep the original csv rather than delete?

Sub Text2cols()
    Dim objRange1 As Range
   

    'Set up the ranges
    Set objRange1 = Range("A:A")


    'Do the first parse
    objRange1.TexttoColumns _
      Destination:=Range("A1"), _
      DataType:=xlDelimited, _
      Tab:=False, _
      Semicolon:=False, _
      Comma:=False, _
      Space:=False, _
      Other:=True, _
      OtherChar:="|"

End Sub

_____________________________________________________________________

Sub ConvertCSVToXls()
    
    Dim myfile As String
    Dim oldfname As String, newfname As String
    Dim workfile
    Dim folderName As String
    
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    
'   Capture name of current file
    myfile = ActiveWorkbook.Name
    
'   Set folder name to work through
    folderName = "filepath\csv files\"
    
'   Loop through all CSV files in folder
    workfile = Dir(folderName & "*.CSV")
    Do While workfile <> ""
'       Open CSV file
        Workbooks.Open Filename:=folderName & workfile
                
        Call Text2cols
        
'       Capture name of old CSV file
        oldfname = ActiveWorkbook.FullName
'       Convert to XLS
        newfname = folderName & Left(ActiveWorkbook.Name, Len(ActiveWorkbook.Name) - 4) & ".xls"
        ActiveWorkbook.SaveAs Filename:=newfname, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
        ActiveWorkbook.Close
'       Delete old CSV file
        Kill oldfname
        Windows(myfile).Activate
        workfile = Dir()
    Loop
    
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True

End Sub


0

There are 0 answers