Automatic Email forward error

P

PSM

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 th
first approver rather than the next in sequence. I cannot see where th
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) <> "No
Approved" Then varResponses(i) = ""
If varResponses(i) <> "" And varApprovers(i) = "" The
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 approve
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 Su
 
S

Sheeloo

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?
 
P

PSM

I cannot seem to upload file. xls is not supported and when I zip th
file it "fails to upload". THe file size when zipped is only 20.0Kb.
Ahhhhh, this is very frustrating.

'Sheeloo[_3_ said:
;3240379']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 NO
APPROVED...

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

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

:
-

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 wher
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
Click to expand...
 
S

Sheeloo

You can mail it to me
to_sheeloo
@hotmail.com

or upload at a site like wikisend.com
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

runtime error 9 subscript out of range 1
Word Macro for multiple searches, incl. in footnotes 2
type mismatch error in macro in excel 0
Date and Time 1
emailing worksheet problem 4
Help with this error "PasteSpecial method of Range class failed !! 0
Unhide sheet, copy and rename new sheets from list, rehide sheet 8
Exclude a range from "0" 4

Top