VBA Save Copy as csv complete with name and datestamp

Status
Not open for further replies.

KasperC

New Member
Joined
May 11, 2023
Messages
49
Office Version
  1. 365
Platform
  1. Windows
  2. MacOS
Hello,

I'm really new when it comes to excel, and are really just trying to piece together strings from different forums alongside trying to learn.

I'm trying to Save a Copy as a CSV file, without the need of choosing a file-name or path - I really just want the file to appear in the correct folder, with the name, a custom stamp, and date.
Something like this: "name"_"insert_string"_ddmmyyyy

Also, I want the original ws to close without saving after completion - right now its returning a blank excel form that I have to close manually.

This is what I've gotten thus far - I've snatched most of it from an answer Mr. John_W made to a post some while ago
VBA Code:
    Dim folderPath As String
    Dim csvFile As String
    Dim dto As String, name As String, insert_string As String

    name = "name"
    dto = Format(CStr(Now), "ddmmyyyy")
    insert_string = InputBox("Prompt")
    
    folderPath = "\path"
 
    csvFile = Application.GetSaveAsFilename(InitialFileName:=folderPath, _
                FileFilter:="CSV (semikolondelt) (*.csv), *.csv", Title:="Save As CSV")
 
    If csvFile <> "" And csvFile <> "False" Then
        Application.ScreenUpdating = False
        ActiveSheet.Copy
        On Error Resume Next
        ActiveWorkbook.SaveAs Filename:=csvFile, FileFormat:=xlCSV, Local:=True, _
        Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, CreateBackup:=False, ConflictResolution:=xlUserResolution
        
        On Error GoTo 0
        
        ActiveWorkbook.Close SaveChanges:=False
        Application.ScreenUpdating = True
    End If
    
ActiveWorkbook.Close SaveChanges:=False

Anyone got any ideas?

Much appreciated,
Kasper C

 

Excel Facts

Last used cell?
Press Ctrl+End to move to what Excel thinks is the last used cell.
Pehaps this.
VBA Code:
Sub SaveToCSV()
    Dim Folder As String, FileName As String, FilePath As String, Msg As String
    Dim DestWB As Workbook
    Dim Ans As Integer
    Dim dto As String, insert_string As String
    
    Folder = "C:\Users\MyUser\Documents\MyFolder"     '<<<< Edit to add YOUR folder
    FileName = "name"                                 '<<<< Edit to add YOUR name

    insert_string = InputBox("Prompt")
    If insert_string = "" Then
        MsgBox "An entry is required"
        Exit Sub
    End If
    
    dto = Format(CStr(Now), "ddmmyyyy")
    
    Folder = Trim(Folder)
    If Not Right(Folder, 1) = "\" Then
        Folder = Folder & "\"
    End If
    
    FileName = FileName & "_" & insert_string & "_" & dto & ".csv"
    
    Msg = "Save to this file?" & vbCr & vbCr
    Msg = Msg & Folder & FileName
    Ans = MsgBox(Msg, vbOKCancel)
    If Ans = vbOK Then
        If InStr(FileName, ".") > 0 Then
            FileName = Left(FileName, InStr(FileName, ".") - 1)
        End If
        
        FilePath = Folder & FileName & ".xlsm"
        Application.DisplayAlerts = False
        ThisWorkbook.SaveCopyAs (FilePath)
        DoEvents
        Set DestWB = Application.Workbooks.Open(FileName:=FilePath)
        DoEvents
        
        DestWB.SaveAs FileName:=Folder & FileName & ".csv", FileFormat:=xlCSV
        DoEvents
        DestWB.Close False
        Kill FilePath
        Application.DisplayAlerts = True
        If MsgBox("Close this workbook w/o saving?", vbYesNo Or vbQuestion, ThisWorkbook.Name) = vbYes Then
             ThisWorkbook.Close False
        End If
    End If
End Sub
 
Upvote 2
Solution
Pehaps this.
VBA Code:
Sub SaveToCSV()
    Dim Folder As String, FileName As String, FilePath As String, Msg As String
    Dim DestWB As Workbook
    Dim Ans As Integer
    Dim dto As String, insert_string As String
   
    Folder = "C:\Users\MyUser\Documents\MyFolder"     '<<<< Edit to add YOUR folder
    FileName = "name"                                 '<<<< Edit to add YOUR name

    insert_string = InputBox("Prompt")
    If insert_string = "" Then
        MsgBox "An entry is required"
        Exit Sub
    End If
   
    dto = Format(CStr(Now), "ddmmyyyy")
   
    Folder = Trim(Folder)
    If Not Right(Folder, 1) = "\" Then
        Folder = Folder & "\"
    End If
   
    FileName = FileName & "_" & insert_string & "_" & dto & ".csv"
   
    Msg = "Save to this file?" & vbCr & vbCr
    Msg = Msg & Folder & FileName
    Ans = MsgBox(Msg, vbOKCancel)
    If Ans = vbOK Then
        If InStr(FileName, ".") > 0 Then
            FileName = Left(FileName, InStr(FileName, ".") - 1)
        End If
       
        FilePath = Folder & FileName & ".xlsm"
        Application.DisplayAlerts = False
        ThisWorkbook.SaveCopyAs (FilePath)
        DoEvents
        Set DestWB = Application.Workbooks.Open(FileName:=FilePath)
        DoEvents
       
        DestWB.SaveAs FileName:=Folder & FileName & ".csv", FileFormat:=xlCSV
        DoEvents
        DestWB.Close False
        Kill FilePath
        Application.DisplayAlerts = True
        If MsgBox("Close this workbook w/o saving?", vbYesNo Or vbQuestion, ThisWorkbook.Name) = vbYes Then
             ThisWorkbook.Close False
        End If
    End If
End Sub

This works perfectly! Thank you so much!

/Kasper
 
Upvote 0
hi ,
i too am pretty new to VBA.
I found the above very useful, but would like to add additional columns to the sheet prior to saving.

my report is a table generated out of Power Query. I need it to save in a specific CSV format for upload into another software.
The image below shows both the table format and the desired CSV format

1685314807933.png
 
Upvote 0
Hi. Welcome to the forum. You should probably start a new thread for that question/ask ,since it is not really related to the topic of this post. Also there is a separate sub-forum for Power Query questions.
 
Upvote 0
Status
Not open for further replies.

Forum statistics

Threads
1,215,219
Messages
6,123,678
Members
449,116
Latest member
HypnoFant

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top