Help with saving file in multiple directories

[singcbl]

I have presently the codes to save the working file and one with a date stamp. I have been requested to save the same file to another folder in a different directory. I tried recording the macro but the result was not very satisfactory. I appreciate your help to see if I can change the code in SaveFile3. There is an error message if I decide not to save the file after the macro is run.

The filename - "ACR2301B.xls"
The folder location - "I:\Final Cost Forecast-Infra\WP2301\"
The new folder location - "S:\Infrastructure Section\Commercial Management\CR & EW\CR Tracking\ACR Infra"

The existing codes

 Sub SaveFile()
    Dim f As Variant
    Dim strFileName As String
    Dim strFileDirectory As String
    Dim fname As String
    Dim var As Variant
     
    fname = "ACR-WP2301B"
    strFileName = fname & " " & Format(Now(), "yyyy-mm-dd") & ".xls"
    strFileDirectory = "I:\Final Cost Forecast-Infra\WP2301\"
 
    'Show the SaveAs box
    f = Application.GetSaveAsFilename(InitialFileName:=strFileDirectory & strFileName, _
        FileFilter:="Microsoft Excel Workbook (*.xls),*.xls")
 
    If f <> False Then
        If Dir(strFileDirectory & strFileName, vbNormal) = "" Then
            ActiveWorkbook.SaveAs strFileDirectory & strFileName
        Else
        End If
    End If
        
    Call SaveFile2
    Call SaveFile3

End Sub [code]

[code] Sub SaveFile2()

    Dim strFileName As String
    Dim strFileDirectory As String
    Dim var As Variant
    
    strFileDirectory = "I:\Final Cost Forecast-Infra\WP2301\"
    strFileName = "ACR-WP2301B"
        
    If Dir(strFileDirectory & strFileName & ".xls", vbNormal) = "" Then
        ActiveWorkbook.SaveAs strFileDirectory & strFileName, 56
    Else
        
        var = MsgBox("File " & strFileName & " already exist" & vbNewLine & "Do you want to replace?", vbYesNoCancel)
        If var = vbYes Then
            Application.DisplayAlerts = False
            ActiveWorkbook.SaveAs strFileDirectory & strFileName
            Application.DisplayAlerts = True
        Else
            Exit Sub
        End If
    End If
    
End Sub [code]

[code] Sub SaveFile3()
'
' Macro2 Macro
' Macro recorded 7/23/2010 by andy.tan
'

    ChDir _
        "S:\Infrastructure Section\Commercial Management\CR & EW\CR Tracking\ACR Infra"
    ActiveWorkbook.SaveAs Filename:= _
        "S:\Infrastructure Section\Commercial Management\CR & EW\CR Tracking\ACR Infra\ACR-WP2301B.xls"
End Sub [code]

 

[singcbl]

Noticed the error in the posting, so have made the correction. Any suggestion?

The existing codes

 Sub SaveFile()
Dim f As Variant
Dim strFileName As String
Dim strFileDirectory As String
Dim fname As String
Dim var As Variant

fname = "ACR-WP2301B"
strFileName = fname & " " & Format(Now(), "yyyy-mm-dd") & ".xls"
strFileDirectory = "I:\Final Cost Forecast-Infra\WP2301\"

'Show the SaveAs box
f = Application.GetSaveAsFilename(InitialFileName:=strFileDirectory & strFileName, _
FileFilter:="Microsoft Excel Workbook (*.xls),*.xls")

If f <> False Then
If Dir(strFileDirectory & strFileName, vbNormal) = "" Then
ActiveWorkbook.SaveAs strFileDirectory & strFileName
Else
End If
End If

Call SaveFile2
Call SaveFile3

End Sub

 Sub SaveFile2()

Dim strFileName As String
Dim strFileDirectory As String
Dim var As Variant

strFileDirectory = "I:\Final Cost Forecast-Infra\WP2301\"
strFileName = "ACR-WP2301B"

If Dir(strFileDirectory & strFileName & ".xls", vbNormal) = "" Then
ActiveWorkbook.SaveAs strFileDirectory & strFileName, 56
Else

var = MsgBox("File " & strFileName & " already exist" & vbNewLine & "Do you want to replace?", vbYesNoCancel)
If var = vbYes Then
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs strFileDirectory & strFileName
Application.DisplayAlerts = True
Else
Exit Sub
End If
End If

End Sub

 Sub SaveFile3()
'
' Macro2 Macro
' Macro recorded 7/23/2010 by andy.tan
'

ChDir _
"S:\Infrastructure Section\Commercial Management\CR & EW\CR Tracking\ACR Infra"
ActiveWorkbook.SaveAs Filename:= _
"S:\Infrastructure Section\Commercial Management\CR & EW\CR Tracking\ACR Infra\ACR-WP2301B.xls"
End Sub

 

[Richard Schollar]

Hi

I would use the SaveCopyAs method which won't change the name of the Activeworkbook:

'save current file to different location without changing name of activeworkbook:
 
ActiveWorkbook.SaveCopyAs "G:\SomeFolder\SomeName.xls"
 
ActiveWorkbook.SaveCopyAs "H:\SomeOtherFolder\SomeOtherName.xls"

 

[singcbl]

Thanks!
I have tested your suggestion and it is now working fine.