Saving in 2 diff locations at same time.

[Dazzawm]

Is it possible that when I save an xlsm file that at the sametime it can be saved as a csv to a different folder? Thanks.

 

[jasmith4]

You have to dive into the wonderful world of VBA! Hit Alt-F11 to get the VBE windows, hit Ctrl-R to get the Project Explorer, double-click ThisWorkbook under your project's icon, and paste into it this code:

Option Explicit
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    Me.Worksheets(1).SaveAs "Path\FileName.csv", xlCSV
End Sub

I'm assuming this XLSM has one sheet -- you can't save multiple sheets as CSV, which is why I'm using SaveAs on Worksheets(1).

 

[Dazzawm]

This comes up with a Compile error:

'Procedure declaration does not match description of event or procedure having the same name'

and highlights

'Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)'

 

[Dazzawm]

^

 

[jasmith4]

Can't be. I've wrote the code in 2003, but then I started from scratch in both 2007 and 2010, making sure I saved it as XLSM, and it compiles fine. Are you sure you put the code in ThisWorkbook under Microsoft Excel Objects?

Actually the issue I found was recursion: every time the file gets saved -- by the user or the code -- Workbook_BeforeSave is called, so if there's any Save or SaveAs command in Workbook_BeforeSave, it's called recursively.

Here's how I prevented that -- it compiles OK in an XLSM file in 2010:

Option Explicit
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
 
    Static AlreadySaving As Boolean     ' Prevent recursion
    If AlreadySaving Then Exit Sub
                                        ' Get file and app information
    Dim FF As XlFileFormat: FF = Me.FileFormat
    Dim FN As String:       FN$ = Me.FullName
    Dim DA As Boolean:      DA = Application.DisplayAlerts
 
    AlreadySaving = True                ' Prevent recursion
    Application.DisplayAlerts = False
                                        ' Save as CSV, which would recurse
    Me.Worksheets(1).SaveAs "path\name.csv", xlCSV
    Me.SaveAs FN$, FF                   ' Save as original, which would recurse
 
    Application.DisplayAlerts = DA      ' Restore alerts
 
    Cancel = True                       ' Prevent saving again
 
    AlreadySaving = False               ' Allow re-saving
End Sub

 

[Dazzawm]

It works, sort of!. When I close the workbook it does save as CSV to the location I want but it doesnt close down altogether i. e I want it to close as a CSV to the specified location and also as an xlsm in its current location. Thanks.

 

[Dazzawm]

It works, sort of!. When I close the workbook it does save as CSV to the location I want but it doesnt close down altogether i. e I want it to close as a CSV to the specified location and also as an xlsm in its current location. Thanks.

Any more advice on this Jasmith4 please?

 

[Jaafar Tribak]

Try this and see if it works for you : (will save a CVS copy in the workbook folder)

Option Explicit

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)

    Dim oHiddenApp As New Application
    Dim oWb As Workbook
    Dim sPathName As String
    
    sPathName = Left(FullName, Len(FullName) - 5)
    SaveCopyAs sPathName & ".cvs"
    With oHiddenApp
        Set oWb = .Workbooks.Open(sPathName & ".cvs")
        .Calculation = xlCalculationManual
        .DisplayAlerts = False
        .EnableEvents = False
        oWb.SaveAs sPathName & ".cvs", xlCSV
        oWb.Close False
        .Quit
    End With
    Set oHiddenApp = Nothing
    Set oWb = Nothing

End Sub

 

[Dazzawm]

Try this and see if it works for you : (will save a CVS copy in the workbook folder)

Option Explicit
 
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
 
    Dim oHiddenApp As New Application
    Dim oWb As Workbook
    Dim sPathName As String
 
    sPathName = Left(FullName, Len(FullName) - 5)
    SaveCopyAs sPathName & ".cvs"
    With oHiddenApp
        Set oWb = .Workbooks.Open(sPathName & ".cvs")
        .Calculation = xlCalculationManual
        .DisplayAlerts = False
        .EnableEvents = False
        oWb.SaveAs sPathName & ".cvs", xlCSV
        oWb.Close False
        .Quit
    End With
    Set oHiddenApp = Nothing
    Set oWb = Nothing
 
End Sub

Where do I put the path name where the csv is to be saved. Also the path name begins with \\ which may cause problems.

 

[Jaafar Tribak]

Ignore the previous code as I forgot to handle the scenario where the workbook is not saved to disk yet.

Try this :

Option Explicit

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)

    'first save only.
    On Error Resume Next
        If Len(Dir(FullName)) = 0 Then
        With Application
        .DisplayAlerts = False
        .EnableEvents = False
        Save
        Call SaveCVS
        Application.OnTime Now, Me.CodeName & ".SaveCVS"
        .EnableEvents = True
        .DisplayAlerts = True
        End With
        End If
    On Error GoTo 0
    
    'subsequent saves.
    Call SaveCVS

End Sub

Private Sub SaveCVS()

    Dim oHiddenApp As New Application
    Dim oWb As Workbook
    Dim sPathName As String


    sPathName = Left(FullName, Len(FullName) - 5)
    SaveCopyAs sPathName & ".cvs"
    With oHiddenApp
        Set oWb = .Workbooks.Open(sPathName & ".cvs")
        .Calculation = xlCalculationManual
        .DisplayAlerts = False
        .EnableEvents = False
        oWb.SaveAs sPathName & ".cvs", xlCSV
        oWb.Close False
        .Quit
    End With
    Set oHiddenApp = Nothing
    Set oWb = Nothing

End Sub

The path of the CVS file copy will be automatically the same as that of the workbook. You can change this by editing the code.