VBA - saving file to 2 places on my hard drive

[shophoney]

Hi,

Below is VBA i created to refresh a file everyday when it opens and I would like to save it to 2 spots on my hard drive.

Is there a better way to specify where to out the copies. I feel my code is a bit sloppy.

Please let me know your comments.

Thanks

Private Sub Workbook_Open()
    On Error Resume Next
    ' Schedule the Save&CloseWorkbook procedure at 5:30 PM
    Application.OnTime VBA.TimeValue("6:55:00"), "SaveAndCloseWorkBook", , True
   
    Dim rngFindTodaysDate As Range
   With ThisWorkbook.Worksheets("Status")

        On Error GoTo x
        Set rngFindTodaysDate = .Range("A1").End(xlDown).Find(Date)
        If rngFindTodaysDate Is Nothing Then
            .Range("A" & .Range("A" & Rows.Count).End(xlUp).Row + 1) = Date

            Workbooks(ThisWorkbook.Name).RefreshALL

        End If
    End With
x:
Application.ExecuteExcel4Macro "Show.Toolbar(""Ribbon"",False)"
ActiveWindow.DisplayHeadings = False
Application.DisplayFormulaBar = False

        Application.DisplayAlerts = False
ChDir "U:\Excel\Inventory"
    ActiveWorkbook.SaveAs Filename:="U:\Excel\Inventory\OH_Historical_FOCUS.xlsb" _
        , FileFormat:=xlExcel12, CreateBackup:=False

ChDir "D:\Dropbox\Shared_Files"
    ActiveWorkbook.SaveAs Filename:="D:\Dropbox\Shared_Files\OH_Historical_FOCUS.xlsb" _
        , FileFormat:=xlExcel12, CreateBackup:=False
    Application.DisplayAlerts = True
   
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    On Error Resume Next
    'Before closing the workbook, remove the schedule
   
    Application.OnTime VBA.TimeValue("6:55:00"), "SaveAndCloseWorkBook", , False
    On Error GoTo 0
End Sub

 

[Legacy 456155]

At a glance, your code seems fine, though I would use ActiveWorkbook.SaveCopyAs instead of SaveAs. I don't see the need for ChDir.
Nevermind my suggestion about SaveCopyAs. I don't think that will work saving in a different format.

From Ohio? I am a former Cincinnatian. My poor Reds. My poor Bengals.