What is the logic behind
If varResponses(i) < "Approved" Or varResponses(i) < _
"Not Approved " Then varResponses(i) = """"

It seems to put " in varResponses(i) if it is not APPROVED or NOT APPROVED...

later recepient is assigned only if
If varResponses(i) = ""

Can you share the Excel with the FORM... so that it is easier to debug?

"PSM" wrote:


I've borrowed code and reused in my own CapEx approval form.
The form is originated and goes through three people for approval.
Everything seems to work ok on the form but it always forwards to the
first approver rather than the next in sequence. I cannot see where the
code is wrong.


Option Base 1
Option Explicit
Sub LookupOutlookName(cel)
Dim cdoSession, cdoAddressBook, olkRecipients, objAE
On Error Resume Next
Set cdoSession = CreateObject("MAPI.Session")
cdoSession.Logon "", "", False, False
Set olkRecipients = cdoSession.AddressBook(, "Global Address List",
0, False)
For Each objAE In olkRecipients
cel.Value = objAE.Name
Next
Set olkRecipients = Nothing
cdoSession.Logoff
Set cdoSession = Nothing
End Sub

Private Sub cmdProdLeader_Click()
Call LookupOutlookName(Me.Range("Approver1"))
End Sub
Private Sub cmdSUSDCoord_Click()
Call LookupOutlookName(Me.Range("Approver2"))
End Sub
Private Sub cmdPlantManager_Click()
Call LookupOutlookName(Me.Range("Approver3"))
End Sub
Private Sub cmdSiteManager_Click()
Call LookupOutlookName(Me.Range("Approver4"))
End Sub

Private Sub cmdRouteButton_Click()
Dim strTemp As String, strErrMsg As String
Dim strRecipient As String, strSubject As String
Dim varApprovers, varResponses
Dim i As Integer
Dim booAppButNoName As Boolean, booSent As Boolean

ReDim varApprovers(4)
ReDim varResponses(4)
booAppButNoName = False
booSent = False
For i = LBound(varApprovers) To UBound(varApprovers)
varApprovers(i) = Trim(Me.Range("Approver" & i).Text)
varResponses(i) = Trim(Me.Range("Response" & i).Text)
If varResponses(i) < "Approved" Or varResponses(i) < "Not
Approved" Then varResponses(i) = ""
If varResponses(i) < "" And varApprovers(i) = "" Then
booAppButNoName = True
Next i
strTemp = ""
For i = LBound(varApprovers) To UBound(varApprovers)
strTemp = strTemp & varApprovers(i)
If strTemp < "" Then Exit For
Next i

If strTemp = "" Then
strErrMsg = "You must select at least 1 approver."
GoTo ErrorExit
ElseIf booAppButNoName = True Then
strErrMsg = "There is an approval response with no approver
name." & Chr(13) & "Please correct the approval section and retry."
GoTo ErrorExit
ElseIf Trim(Me.Range("Originator").Text) = "" Then
strErrMsg = "You must specify an originator."
GoTo ErrorExit
Else
strSubject = "FOR APPROVAL: CAPEX " & Me.Range("Plant_Code") &
" REASON: " & Me.Range("WO")
For i = LBound(varApprovers) To UBound(varApprovers)
Select Case varApprovers(i)
Case ""
Case Else
If varResponses(i) = "" Then
strRecipient = varApprovers(i)
booSent = True
GoTo SendWorkbook
Else
End If
End Select
Next i
If booSent = False Then
strRecipient = Trim(Me.Range("Originator").Text)
strSubject = "COMPLETE: " & strSubject
Else
strErrMsg = "Problem with booSent logic (cmdRouteButton).
Contact philip.marshall"
GoTo ErrorExit
End If
End If

SendWorkbook:

ThisWorkbook.ActiveSheet.Copy
ActiveWorkbook.SendMail _
Recipients:=strRecipient, _
Subject:=strSubject, _
returnreceipt:=False
ActiveWorkbook.Close savechanges:=False

GoTo NormalExit

ErrorExit:
MsgBox (strErrMsg)

NormalExit:

End Sub




--
PSM