Option Explicit 
Private Sub Workbook_BeforePrint(Cancel As Boolean) 
    Dim fname As String, str As String, i As Long, myLen As Long, _ 
    cnt As Long, sname As String, myset As String 
    fname = ActiveWorkbook.FullName 
    sname = ActiveWorkbook.Name 
    myLen = Len(fname) 'full length of path and filename, used to step through
     ' each character and check for folder seperator "\"
    cnt = 0 
    On Error GoTo lessThanAmt 'Errors out if the number you set below does not
     ' get met before the iteration is fully completed
    For i = myLen To 1 Step -1 
        If cnt > 2 Then 'Set number for how many folders deep you want to see
            str = Right(fname, myLen - i + 1) 
            Exit For 'Exit when a match is found
        End If 
         'Before match is met, check each character with Mid Function
        If Mid(fname, i - 1, 1) = "\" Then 
            cnt = cnt + 1 
        End If 
    Next i 
    If str <> "" Then 
        str = ".." & Left(str, Len(str) - Len(ActiveWorkbook.Name)) & sname 
    End If 
    With ActiveSheet.PageSetup 
         'Set Font, Font Attribute and Font Size here if you'd like
        myset = "&""Tahoma,Italic""&10" 
        .RightFooter = myset & str 
    End With 
    Exit Sub 
lessThanAmt: 
    With ActiveSheet.PageSetup 
         'Set Font, Font Attribute and Font Size here if you'd like
        myset = "&""Tahoma,Italic""&10" 
         'Make the footer default to the Full Path on errors
        .RightFooter = myset & fname 
    End With 
    Err.Clear 
End Sub