0

I've VBA code to convert a folder of xls files to csv.

I'd also like to convert the date formatting in column H of each file to "MMM-YY".

I tried including another loop to format the dates.

I'd like each xls to be saved as a CSV and then convert the formatting of column H in the CSV to "MMM-YY" formatting.

The script below allows the user to select the folder with the files to convert and the folder to save these files in. I'd like that to be the maximum user input if possible.

XLS to CSV script:

Sub WorkbooksSaveAsCsvToFolder()
 
    Dim xObjWB As Workbook
    Dim xObjWS As Worksheet
    Dim xStrEFPath As String
    Dim xStrEFFile As String
    Dim xObjFD As FileDialog
    Dim xObjSFD As FileDialog
    Dim xStrSPath As String
    Dim xStrCSVFName As String
    Dim xS As String

    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.Calculation = xlCalculationManual
    Application.DisplayAlerts = False

    On Error Resume Next

    Set xObjFD = Application.FileDialog(msoFileDialogFolderPicker)

    xObjFD.AllowMultiSelect = False
    xObjFD.Title = "Select a folder which contains Excel files"

    If xObjFD.Show <> -1 Then Exit Sub

    xStrEFPath = xObjFD.SelectedItems(1) & "\"

    Set xObjSFD = Application.FileDialog(msoFileDialogFolderPicker)

    xObjSFD.AllowMultiSelect = False
    xObjSFD.Title = "Select a folder to locate CSV files"

    If xObjSFD.Show <> -1 Then Exit Sub

    xStrSPath = xObjSFD.SelectedItems(1) & "\"
    xStrEFFile = Dir(xStrEFPath & "*.xls*")

    Do While xStrEFFile <> ""

        xS = xStrEFPath & xStrEFFile

        Set xObjWB = Application.Workbooks.Open(xS)
        xStrCSVFName = xStrSPath & Left(xStrEFFile, InStr(1, xStrEFFile, ".") - 1) & ".csv"
        xObjWB.SaveAs Filename:=xStrCSVFName, FileFormat:=xlCSV
        xObjWB.Close SaveChanges:=False
        xStrEFFile = Dir

    Loop

    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True

End Sub

Attempt at converting XLS to CSV and formatting date:

Sub WorkbooksSaveAsCsvToFolder()

    Dim xObjWB As Workbook
    Dim xObjWS As Worksheet
    Dim xStrEFPath As String
    Dim xStrEFFile As String
    Dim xStrSFile As String
    Dim xObjFD As FileDialog
    Dim xObjSFD As FileDialog
    Dim xStrSPath As String
    Dim xStrCSVFName As String
    Dim xS As String

    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.Calculation = xlCalculationManual
    Application.DisplayAlerts = False

    On Error Resume Next

    Set xObjFD = Application.FileDialog(msoFileDialogFolderPicker)

    xObjFD.AllowMultiSelect = False
    xObjFD.Title = "Select a folder which contains Excel files"

    If xObjFD.Show <> -1 Then Exit Sub

    xStrEFPath = xObjFD.SelectedItems(1) & "\"

    Set xObjSFD = Application.FileDialog(msoFileDialogFolderPicker)
    xObjSFD.AllowMultiSelect = False
    xObjSFD.Title = "Select a folder to locate CSV files"
    
    If xObjSFD.Show <> -1 Then Exit Sub

    xStrSPath = xObjSFD.SelectedItems(1) & "\"
    xStrEFFile = Dir(xStrEFPath & "*.xls*")

    Do While xStrEFFile <> ""

        xS = xStrEFPath & xStrEFFile
        
        Set xObjWB = Application.Workbooks.Open(xS)
        xStrCSVFName = xStrSPath & Left(xStrEFFile, InStr(1, xStrEFFile, ".") - 1) & ".csv"
        xObjWB.SaveAs Filename:=xStrCSVFName, FileFormat:=xlCSV
        xObjWB.Close SaveChanges:=False
        xStrEFFile = Dir
        
    Loop
       
    xStrSFile = Dir(xStrSPath & "*.csv*")

    Do While xStrSFile <> ""
      
        xStrCSVFName = xStrSPath & Left(xStrSFile, InStr(1, xStrSFile, ".") - 1) & ".csv"
      
        xD = xStrSPath & xStrCSVFName
       
        Set xStrWB = Application.Workbooks.Open(xD)
        
        xD.Worksheets(1).Columns("H:H").NumberFormat = "mmm-yy"
        xStrWB.Close SaveChanges:=True
        xStrSFile = Dir

    Loop

    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True

End Sub
Improve this question

1 Answer 1

Reset to default
1

Please, try the next adapted code. No need of another iteration between files:

Sub WorkbooksSaveAsCsvToFolder()
  Dim xObjWB As Workbook, xObjWS As Worksheet
  Dim xStrEFPath As String, xStrEFFile As String, xStrSFile As String

  Dim xObjFD As FileDialog, xObjSFD As FileDialog
  Dim xStrSPath As String, xStrCSVFName As String, xS As String

    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.Calculation = xlCalculationManual
    Application.DisplayAlerts = False

    'On Error Resume Next

   Set xObjFD = Application.FileDialog(msoFileDialogFolderPicker)

    xObjFD.AllowMultiSelect = False

    xObjFD.Title = "Select a folder which contains Excel files"

    If xObjFD.Show <> -1 Then Exit Sub

    xStrEFPath = xObjFD.SelectedItems(1) & "\"
    

    Set xObjSFD = Application.FileDialog(msoFileDialogFolderPicker)

    xObjSFD.AllowMultiSelect = False

    xObjSFD.Title = "Select a folder to locate CSV files"

    If xObjSFD.Show <> -1 Then Exit Sub

    xStrSPath = xObjSFD.SelectedItems(1) & "\"


    xStrEFFile = Dir(xStrEFPath & "*.xls*")


    Dim arr, lastR As Long
    Do While xStrEFFile <> ""

           xS = xStrEFPath & xStrEFFile
            
            Set xObjWB = Application.Workbooks.Open(xS)
           lastR = xObjWB.Worksheets(1).Range("H" & rows.count).End(xlUp).row
           With xObjWB.Worksheets(1).Columns("H1:H" & lastR)
                arr = .Value2
                arr = DateAsText(arr)
                .NumberFormat = "@"
                .Value = arr
           End With
            
            xStrCSVFName = xStrSPath & left(xStrEFFile, InStr(1, xStrEFFile, ".") - 1) & ".csv"
    
            xObjWB.saveas fileName:=xStrCSVFName, FileFormat:=xlCSV
    
            xObjWB.Close SaveChanges:=False
            
            xStrEFFile = Dir
            
    Loop
       
    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True

End Sub

Function DateAsText(arrD) As String()
     Dim arrTxt() As String, i As Long
     ReDim arrTxt(1 To UBound(arrD), 1 To 1)
     For i = 1 To UBound(arrD)
         arrTxt(i, 1) = CStr(Format(arrD(i, 1), "MMM-YY"))
     Next i
     DateAsText = arrTxt
End Function
Improve this answer
Sign up to request clarification or add additional context in comments.

6 Comments

Thanks for the quick reply! I've tried your script above, but still doesn't seem to reformat the date unfortunately. When the CSV is opened in excel it is autoamtically reforammted, but whne opened with notepad++ the original foramtting remains. The original formatting is MMM YY, which I would like to format as MMM-YY, but doesn't seem to be formatting correctly. I've got a seperate script running that amends the formatting, but needs to be run seperately. Any ideas? Thanks! :)
@Pepe S Does it what you need? I did not test it, I only tried to put it in a logical way...
@FaneDura unfortunately not, it converts to CSV, but the date formatting doesn't seem to be working. When opening the file in excel, excel auto formats the date, but when opened with notepad++ the original formatting remains, which is the formatting that the system I'm working with is reading.
@Pepe S And in which application do you want keeping the "mmm-yy" format? In a word editor (Notepad) or in Excel? If in Notepad, you should format it as text, previously creating the desired format.
@Pepe S Please, test the updated code and send some feedback.
|

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.