Routing Slips Excel 2003

Hello,

I have a problem with an Excel routing slip which isn't sending a receipt to the other users in the routing chain as it routes on to the next user.

I believe this is controlled by the tracking = true statement but that is set to true and it still isn't working.

Can anyone identify an issue with the code below that would cause that?

Thanks

Josh

Sub josh_route()

 

Dim Addresee As String

Dim Addresee2 As String

Dim MandatesAdd As String

Dim winusername As String

 

winusername = UCase(Environ("UserName")) ' get username of current user

 

Select Case winusername

 

Case UCase(Range("uno").Value) 'IS End USER

    

    'CHECK IF REMOVE ALL MANDATES

    If Range("AP4") = True Then

    Addresse = ""

    Addresee2 = ""

    Sheets("Tracking").Range("D2").FormulaR1C1 = Now

    GoTo routemandate

    End If

 

    'Set END USER route Date

        

    Range("userdate").Value = Now

    Addresse = Range("PAEMAIL").Value ' project accountant

    Addresee2 = Range("SPEMAIl").Value ' project sponsor

        

    GoTo routemandate

    

Case UCase(Range("PANO").Value) 'IS Project Accountant

    

    'CHECK IF REMOVE ALL MANDATES

    If Range("AP4") = True Then

    Addresse = ""

    Addresee2 = ""

    Sheets("Tracking").Range("D2").FormulaR1C1 = Now

    GoTo routemandate

    End If

 

    'Set END USER route Date

        

    Range("coorddate").Value = Now

    Addresse = Range("SPEMAIL").Value ' project accountant

    Addresee2 = ""

        

    GoTo routemandate

    

Case UCase(Range("SPNO").Value) 'IS Project Sponsor

    

    'CHECK IF REMOVE ALL MANDATES

    If Range("AP4") = True Then

    Addresse = ""

    Addresee2 = ""

    Sheets("Tracking").Range("D2").FormulaR1C1 = Now

    GoTo routemandate

    End If

 

    'Set END USER route Date

        

    Range("managdate").Value = Now

    Addresse = ""

    Addresee2 = ""

        

    GoTo routemandate

    

End Select

 

routemandate:

 

Username = Sheets("Tracking").Range("B2").Value ' set the user name for inclusion in the subject

 

MandatesAdd = Sheets("Tracking").Range("A28").FormulaR1C1 ' set the mandates team email address

 

On Error Resume Next

  ActiveWorkbook.HasRoutingSlip = False

  ActiveWorkbook.HasRoutingSlip = True

    With ActiveWorkbook.RoutingSlip

        .Recipients = Array(Addresse, Addresee2, MandatesAdd)

        .Subject = "Routing: CMAF for " & Username

        .Message = "Please find the attached Corporate Mandates Approval Form. Please check the details and approve the form using the appropriate button on the form"

        .Delivery = xlOneAfterAnother

        .ReturnWhenDone = False

        .trackstatus = True

    End With

    

On Error GoTo Err_trap

routenext1:

ActiveWorkbook.route

 

Application.DisplayAlerts = False

ActiveWorkbook.Close ([No])

Call protectme

Exit Sub

Err_trap:

If Err <> 0 Then

MsgBox Err.Description, vbInformation, "VBADUD AutoMail"

Err.Clear

End If

GoTo routenext1

 

 

End Sub

Select allOpen in new window