Home Menu

Menu


ExcelBanter » Excel Newsgroups » Excel Worksheet Functions > Automatic Email forward error
Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Posted to microsoft.public.excel.worksheet.functions
external usenet poster
  
Posts: 1
Default Automatic Email forward error

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
Reply With QuoteReply With Quote
  #2   Report Post  
Posted to microsoft.public.excel.worksheet.functions
external usenet poster
  
Posts: 1,805
Default Automatic Email forward error
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

Reply With QuoteReply With Quote
  #3   Report Post  
Posted to microsoft.public.excel.worksheet.functions
external usenet poster
  
Posts: 1
Default Automatic Email forward error

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

'Sheeloo[_3_ Wrote:
;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 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
-




--
PSM
Reply With QuoteReply With Quote
  #4   Report Post  
Posted to microsoft.public.excel.worksheet.functions
external usenet poster
  
Posts: 1,805
Default Automatic Email forward error
You can mail it to me
to_sheeloo
@hotmail.com

or upload at a site like wikisend.com

"PSM" wrote:


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

Reply With QuoteReply With Quote
Reply
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes
Linear Mode Linear Mode

Posting Rules
Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On

Similar Threads
Thread Thread Starter Forum Replies Last Post
Automatic email addresses chesjak Excel Worksheet Functions 1 March 3rd 09 03:49 PM
Automatic email from excel Steve Excel Discussion (Misc queries) 2 May 6th 08 05:32 AM
Automatic Email Link Seorges Excel Discussion (Misc queries) 1 September 5th 06 01:08 AM
Generating an automatic email? EMAIL QUESTION Excel Discussion (Misc queries) 2 June 7th 06 02:59 AM
How do I set up a macro to forward an Excel Spreadsheet via email John Excel Discussion (Misc queries) 0 August 17th 05 08:41 PM


All times are GMT +1. The time now is 07:08 AM.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Copyright ©2004-2024 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"

 

Contact Us ExcelBanter forum home Privacy Statement