Renaming a CSV file after import

[Fishboy]

Hi All,

I am using Excel 2010 and have a workbook set up that imports data from a CSV file when a macro button is pressed. What I would like to do is to then rename that CSV file after the import is completed, specifically adding the date on the end of the filename.

For a simplified example, the macro looks in "C:\CSV Folder" for a file called "Test.csv" and imports it. Once this is complete I would like Excel to rename Test.csv to "Test - Today's Date.csv"

I already have all my working code for the import, but I am stumped how to get the CSV file renamed. Does anyone have any suggestions?

 

[Joe4]

This snippet of code should do what you want. You can of course change the format of how you want the date to appear.

    Dim myFileName As String
    Dim myFilePath As String
    Dim myDate As String
    Dim newFileName As String
    
'   Place the following code in a section after the CSV is imported and is the active file
    
    myFileName = ActiveWorkbook.Name
    myFilePath = ActiveWorkbook.Path & "\"
    myDate = Format(Date, "yyyymmdd")
    
    newFileName = myFilePath & Left(myFileName, Len(myFileName) - 4) & myDate & ".csv"
    
    ActiveWorkbook.SaveAs Filename:=newFileName, _
        FileFormat:=xlCSV, CreateBackup:=False

You could actually condense this down into fewer lines, but I broke it out so it is easier to see where all the values are coming from.

 

[Fishboy]

This snippet of code should do what you want. You can of course change the format of how you want the date to appear.

    Dim myFileName As String
    Dim myFilePath As String
    Dim myDate As String
    Dim newFileName As String
    
'   Place the following code in a section after the CSV is imported and is the active file
    
    myFileName = ActiveWorkbook.Name
    myFilePath = ActiveWorkbook.Path & "\"
    myDate = Format(Date, "yyyymmdd")
    
    newFileName = myFilePath & Left(myFileName, Len(myFileName) - 4) & myDate & ".csv"
    
    ActiveWorkbook.SaveAs Filename:=newFileName, _
        FileFormat:=xlCSV, CreateBackup:=False

You could actually condense this down into fewer lines, but I broke it out so it is easier to see where all the values are coming from.

Hi Joe4,

Thanks for your suggestion, and sorry it has taken me so long to reply. Unfortunately this is not quite what I am looking for. The above code basically saves another copy of my open workbook as "exisiting filename.date".csv.

What I would like to do is have VBA rename only the source CSV file after import. The open workbook remains unchanged beyond new data having been imported.

I now include a copy of the test code I have been working on. Please note that this so called "super macro" is basically 2 different CSV imports one after the other all now running from a single button press instead of needing 2 separate buttons. I have left the comments highlighted in green to make it more obvious what is supposed to be happening. The 2 imported CSV filenames have been highlighted in red.

Basically once the imports are completed, Accounting-Purchases-Defias_Brotherhood.csv needs to be renamed to Accounting-Purchases-Defias_Brotherhood - "Date".csv and Accounting-Sales-Defias_Brotherhood.csv needs to be renamed to Accounting-Sales-Defias_Brotherhood - "Date".csv but the actual open workbook is not being renamed.

Sub SuperMacro2()Dim lr As Long
Dim lr2 As Long
Dim LastRow As Long
Dim ws As Worksheet
Dim rng1 As Range
'
[COLOR=#008000]' New_Import Macro[/COLOR]
'
MsgBox "Macro Started"
[COLOR=#008000]' Import 1st CSV[/COLOR]
    With Application
    .Calculation = xlCalculationManual
    .EnableEvents = False
    .ScreenUpdating = False
    End With
    Application.ScreenUpdating = False
    Sheets("Dashboard").Select
    Sheets("Imported Purchase Data").Visible = True
    Sheets("Imported Purchase Data").Select
    Sheets("Raw Consolidated Data").Visible = True
    Sheets("Imported Purchase Data").Select
    Cells.Select
    Selection.ClearContents
    Range("A1").Select
    With ActiveSheet.QueryTables.Add(Connection:= _
        "TEXT;C:\DBAH\[COLOR=#ff0000]Accounting-Purchases-Defias_Brotherhood.csv[/COLOR]", Destination:= _
        Range("$A$1"))
        .Name = "Accounting-Purchases-Defias_Brotherhood"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 65001
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = False
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = True
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With
[COLOR=#008000]' Add "Purchase" to column J of Imported Purchase Data[/COLOR]
    Application.ScreenUpdating = False
    Range("J2").Select
    ActiveCell.FormulaR1C1 = "Purchase"
    LastRow = Cells(Cells.Rows.Count, "A").End(xlUp).Row
    Range("J2:J" & LastRow).FillDown
[COLOR=#008000]' Copy from Imported to Consolidated and Remove Duplicates[/COLOR]
    lr = Sheets("Imported Purchase Data").Cells(Rows.Count, 1).End(xlUp).Row
    Sheets("Imported Purchase Data").Range("A2:J" & lr).Copy Sheets("Raw Consolidated Data").Range("A" & Rows.Count).End(xlUp)(2)
    Sheets("Raw Consolidated Data").Select
    Columns("A:J").Select
    ActiveSheet.Range("A:J").RemoveDuplicates Columns:=Array(1, 2, 3, 4, 5, 6 _
        , 7, 8, 9, 10), Header:=xlYes
    MsgBox "Purchase Data Imported"
[COLOR=#008000]' Import 2nd CSV[/COLOR]
    With Application
    .Calculation = xlCalculationManual
    .EnableEvents = False
    .ScreenUpdating = False
    End With
    Application.ScreenUpdating = False
    Sheets("Dashboard").Select
    Sheets("Imported Sales Data").Visible = True
    Sheets("Imported Sales Data").Select
    Sheets("Raw Consolidated Data").Visible = True
    Sheets("Imported Sales Data").Select
    Cells.Select
    Selection.ClearContents
    Range("A1").Select
    With ActiveSheet.QueryTables.Add(Connection:= _
        "TEXT;C:\DBAH\[COLOR=#ff0000]Accounting-Sales-Defias_Brotherhood.csv[/COLOR]", Destination:= _
        Range("$A$1"))
        .Name = "Accounting-Sales-Defias_Brotherhood"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 65001
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = False
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = True
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With
[COLOR=#008000]' Add "Sale" to column J of Imported Sales Data[/COLOR]
    Application.ScreenUpdating = False
    Sheets("Imported Sales Data").Select
    Range("J2").Select
    ActiveCell.FormulaR1C1 = "Sale"
    LastRow = Cells(Cells.Rows.Count, "A").End(xlUp).Row
    Range("J2:J" & LastRow).FillDown
[COLOR=#008000]' Copy from Imported to Consolidated and Remove Duplicates[/COLOR]
    lr = Sheets("Imported Sales Data").Cells(Rows.Count, 1).End(xlUp).Row
    Sheets("Imported Sales Data").Range("A2:J" & lr).Copy Sheets("Raw Consolidated Data").Range("A" & Rows.Count).End(xlUp)(2)
    Sheets("Raw Consolidated Data").Select
    Columns("A:J").Select
    ActiveSheet.Range("A:J").RemoveDuplicates Columns:=Array(1, 2, 3, 4, 5, 6 _
        , 7, 8, 9, 10), Header:=xlYes
[COLOR=#008000]' Converts Epoch date to standard date[/COLOR]
    Application.ScreenUpdating = False
    Sheets("Raw Consolidated Data").Select
    Range("K2").Select
    ActiveCell.FormulaR1C1 = "=(((RC[-3]/60)/60)/24)+DATE(1970,1,1)"
    LastRow = Cells(Cells.Rows.Count, "A").End(xlUp).Row
    Range("K2:K" & LastRow).FillDown
    Range("K2:K" & LastRow).Select
    Selection.NumberFormat = "m/d/yyyy"
[COLOR=#008000]' Copy Unique Names to Columm M[/COLOR]
    Application.ScreenUpdating = False
    Range("F2:F" & LastRow).AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range _
    ("F2:F" & LastRow), CopyToRange:=Range("M2"), Unique:=True
[COLOR=#008000]' This part applies a SUMPRODUCT formula to column N to add up the total spend of each unique name, and chages the cell format to currency to 2 decimal places and fills down to end of range[/COLOR]
    Application.ScreenUpdating = False
    Range("N2").Select
    Range("N2").Formula = "=SUMPRODUCT(Consolidated_QuantityTraded,Consolidated_PPU,--(Consolidated_AHNameFull=$M2))/10000"
    Range("N2:N" & LastRow).FillDown
    Range("N2:N" & LastRow).Select
    Selection.NumberFormat = "#,##0.00"
[COLOR=#008000]' This part applies a COUNTIF formula to column O and counts how many times each unique name appears in column E and fills down to end of range[/COLOR]
    Application.ScreenUpdating = False
    Range("O2").Formula = "=COUNTIF(Consolidated_AHNameFull,$M2)"
    Range("O2:O" & LastRow).FillDown
    Set ws = Sheets("Raw Consolidated Data")
    Set rng1 = ws.Range(ws.[j2], ws.Cells(Rows.Count, "J").End(xlUp))
[COLOR=#008000]' This part checks to see if any rows contain the date "01/01/1970" and deletes any rows that have it[/COLOR]
    Application.ScreenUpdating = False
    With ActiveSheet
    .AutoFilterMode = False
    rng1.AutoFilter Field:=1, Criteria1:="01/01/1970"
    rng1.Offset(1, 0).EntireRow.Delete
    .AutoFilterMode = False
    End With
[COLOR=#008000]' This part applies a SUMPRODUCT to columns D and E to get the value of stack size then fills down to end of range in column L[/COLOR]
    Application.ScreenUpdating = False
    Range("L2").Select
    ActiveCell.FormulaR1C1 = "=(RC[-8]*RC[-7])/10000"
    Range("L2:L" & LastRow).FillDown
    Columns("L:L").Select
    Selection.NumberFormat = "#,##0.00"
[COLOR=#008000]' Sorts Transaction by Decending Date[/COLOR]
    Sheets("Raw Consolidated Data").Select
    Columns("H:H").Select
    ActiveWorkbook.Worksheets("Raw Consolidated Data").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Raw Consolidated Data").Sort.SortFields.Add Key:= _
    Range("H1"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
    xlSortTextAsNumbers
    With ActiveWorkbook.Worksheets("Raw Consolidated Data").Sort
        .SetRange Range("A2:O8969")
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
[COLOR=#008000]' Reset Calculation To Automatic[/COLOR]
    With Application
    .Calculation = xlCalculationAutomatic
    .EnableEvents = True
    .ScreenUpdating = True
    End With
    MsgBox "Sales Data Imported"
End Sub

Any other suggestions out there please?

 

[Joe4]

Check out this thread for renaming a file in Excel VBA:http://www.mrexcel.com/forum/excel-...-basic-applications-rename-existing-file.html.
You should be able to incorporate the code I gave you to come up with the naming convention.
Just note that in order to rename the file, you cannot have it open at the time you are trying to rename it.

 

[Fishboy]

Check out this thread for renaming a file in Excel VBA:http://www.mrexcel.com/forum/excel-...-basic-applications-rename-existing-file.html.
You should be able to incorporate the code I gave you to come up with the naming convention.
Just note that in order to rename the file, you cannot have it open at the time you are trying to rename it.

Thanks again Joe4, I'll check it out.

 

[Fishboy]

Yep! Cheers Joe4, that was exactly what I was looking for!

 

[Joe4]

You are welcome. Glad it worked out for you!