Sub SaveToRelativePath()
    Dim rPath As String
    Dim aPath As String
    
    'epoch = DateDiff("S", "1/1/1970", Now())
    dateNow = Format(Now(), "yyyy-MM-dd")
    
    
    pathName = ActiveDocument.FullName
    
    
    onlyName = Mid(pathName, InStrRev(pathName, "\") + 1, InStrRev(pathName, "--") - InStrRev(pathName, "\") - 1)
    ext = Right(pathName, Len(pathName) - InStrRev(pathName, "."))
    
    
    compName = Mid(pathName, InStrRev(pathName, "\") + 1, InStrRev(pathName, ".") - InStrRev(pathName, "\") - 1)
    fileDate = Right(compName, Len(compName) - InStrRev(compName, "--") - 1)
    
    
    If InStr(pathName, "ARCHIVE") = 0 Then
        
        If fileDate = dateNow Then
            rPath = ThisDocument.Path & "\" & onlyName & "--" & dateNow & "." & ext
            aPath = ThisDocument.Path & "\ARCHIVE\" & onlyName & "--" & dateNow & "." & ext
            ActiveDocument.SaveAs FileName:=aPath
            ActiveDocument.SaveAs FileName:=rPath
        Else
            secNow = Format(Now(), "hhmmss")
            rPath = ThisDocument.Path & "\" & onlyName & "--" & dateNow & "." & ext
            aPath = ThisDocument.Path & "\ARCHIVE\" & onlyName & "--" & dateNow & "-" & secNow & "." & ext
            delPath = ThisDocument.Path & "\" & onlyName & "--" & fileDate & "." & ext
            
            ActiveDocument.SaveAs FileName:=aPath
            ActiveDocument.SaveAs FileName:=rPath
            
            If FileExists(aPath) And FileExists(rPath) Then
                If FileExists(delPath) Then
                    SetAttr delPath, vbNormal
                    Kill delPath
                End If
            End If
            
        End If
        
    End If
    

    
    
    
    'compName = Mid(pathName, InStrRev(pathName, "\") + 1, InStrRev(pathName, ".") - InStrRev(pathName, "\") - 1)
    'fileDate = Right(compName, Len(compName) - InStrRev(compName, "--") - 1)
    
    'If fileDate = dateNow Then
        
        'MsgBox "Same Date"
        'Application.DisplayAlerts = False
        
    '    rPath = ThisDocument.Path & "\" & onlyName & "--" & dateNow & "." & ext
    '    ActiveDocument.SaveAs FileName:=rPath
        
        'Application.DisplayAlerts = True
        
    'Else
        
        'MsgBox "Different Date"
    '    rPath = ThisDocument.Path & "\" & onlyName & "--" & dateNow & "." & ext
    '    ActiveDocument.SaveAs FileName:=rPath
        
    'End If
    
End Sub
Function FileExists(ByVal FileToTest As String) As Boolean
   FileExists = (Dir(FileToTest) <> "")
End Function