My Auto-Save macro destroys my Hyperlink paths!

[jmpatrick]

This is a bummer. I have this macro that I wrote based on some (possibly flawed) research. The purpose is to archive my spreadsheet in the background. That seems simple enough. The problem I'm having is after it runs some of the hyperlink paths on both my open sheet and the saved archive copy are altered in a very ugly fashion.

This > GVS_Grandview_Estates_South_7581\GVS_048\GVS_048_plot_plan.pdf
Becomes this > ..\..\GVS_Grandview_Estates_South_7581\GVS_048\GVS_048_plot_plan.pdf

Here's the really strange part. All the links in the first 540 or so rows are fine, and some of the links below 540 are fine (usually if the cell with the link has a value in the cell to the right of it, but not always).

Is my macro possessed?

Here's the code:

Sub SaveWorkbook()

    Application.EnableEvents = False
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

    Dim rootDirectory As String
    Dim folderToBeCreated As String
    Dim path As String
        
        rootDirectory = "\\GLC-SERVER\Pulte\Z_Pulte Master Archive\"

        folderToBeCreated = Format(Now, "yyyy")

        path = rootDirectory & folderToBeCreated

        If Len(Dir(rootDirectory, vbDirectory)) <> 0 Then
            If Len(Dir(path, vbDirectory)) = 0 Then
                VBA.MkDir (path)

            Else
            End If
        Else
        End If

ChDrive "Z"
ChDir "\\GLC-SERVER\Pulte\Z_Pulte Master Archive\"

ActiveWorkbook.SaveCopyAs FileName:="\\GLC-SERVER\Pulte\Z_Pulte Master Archive\" & year(Date) & "\" & "Pulte Master " & Format(Now, "yyyymmdd") & ".xlsm"
   
    Application.EnableEvents = True
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True

End Sub

 

[jmpatrick]

Still struggling with this. I've confirmed that each time the code above runs it adds another ..\..\ to the front of the path. Perplexing...

 

[jmpatrick]

I finally figured this out.

This was the problem: \\GLC-SERVER\Pulte\Z_Pulte Master Archive\" & year(Date) & "\" & "Pulte Master " & Format(Now, "yyyymmdd") & ".xlsm"

Should be this: \Z_Pulte Master Archive\" & year(Date) & "\" & "Pulte Master " & Format(Now, "yyyymmdd") & ".xlsm"

Here's the full code:

Sub SaveWorkbook()

    Application.EnableEvents = False
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

    Dim rootDirectory As String
    Dim folderToBeCreated As String
    Dim path As String
       
        rootDirectory = "\\GLC-SERVER\Pulte\Z_Pulte Master Archive\"

        folderToBeCreated = Format(Now, "yyyy")

        path = rootDirectory & folderToBeCreated

        If Len(Dir(rootDirectory, vbDirectory)) <> 0 Then
            If Len(Dir(path, vbDirectory)) = 0 Then
                VBA.MkDir (path)

            Else
            End If
        Else
        End If

ChDrive "Z"
ChDir "\\GLC-SERVER\Pulte\Z_Pulte Master Archive\"

ActiveWorkbook.SaveCopyAs FileName:="\Z_Pulte Master Archive\" & year(Date) & "\" & "Pulte Master " & Format(Now, "yyyymmdd") & ".xlsm"
   
    Application.EnableEvents = True
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True

End Sub

That will archive the active Workbook in the background in the root directory and put it in a current-year folder. If that folder doesn't exist it will create it.

I use this to auto-run the backup at 7AM (assumes the Workbook is open):

Private Sub Workbook_Open()

Application.OnTime TimeValue("07:00:00"), "SaveWorkbook"
 
End Sub

Hope this helps someone else...