wacko41
asked on
Edit Mapi Message before sending
Hello,
I'm trying to make a function that allows me to send a mapi message but it must not send until the user explicit pushes a send button. Wat i want is that a some kind of dialog (standard oulook sendmail dialog) pops up after the mail has been composed. This will give the user the oppurtunity to check the mail before he sends it himself. Downunder is the code i have so far. This code composes a mapi message but at the end it sends the mail and i can't figure out how to show a sendmail dialog.
thanks,
F.
'------------------------- ---------- ---------- ---------- ---------- -----
' Name : SendMail
' Date : 22-01-1999
' Purpose: This is the front-end function to the MAPISendMail function.
' You pass a semicolon-delimited list of To and CC recipients,
' a subject, a message, and a delimited list of file attachments.
' This function prepares MapiRecip and MapiFile structures with
' the data parsed from the information provided using the
' ParseRecord sub. Once the structures are prepared, the
' MapiSendMail function is called to send the message.
' Comment:
' Input : Subject$ - The text to appear in the subject line of the message
' Receiver$ - Semicolon-delimited list of names to receive the message
' CC$ : Semicolon-delimited list of names to be CC'd
' Attach$: Semicolon-delimited list of files to attach to the message
' Returns: SUCCESS_SUCCESS if successful, or a MAPI error if not.
'------------------------- ---------- ---------- ---------- ---------- -----
Public Function SendMail(ByVal Subject$, ByVal Receiver$, ByVal CC$, ByVal Attach$, ByVal Message$) As String
On Error GoTo SendMail_Err
Dim i, cTo, cCC, cAttach 'variables holding counts
Dim oSession As MAPISession
Dim oMessages As MAPIMessages
Dim msg$
'Count the number of items in each piece of the mail message
cTo = CountTokens(Receiver$, ";")
cCC = CountTokens(CC$, ";")
cAttach = CountTokens(Attach$, ";")
'Create arrays to Receiver$re the semicolon delimited mailing
'information after it is parsed
ReDim rTo(0 To cTo) As String
ReDim rCc(0 To cCC) As String
ReDim rAttach(0 To cAttach) As String
'Parse the semicolon delimited information into the arrays
ParseTokens rTo(), Receiver$, ";"
ParseTokens rCc(), CC$, ";"
ParseTokens rAttach(), Attach$, ";"
'Instantiate Object
Set oSession = CreateObject("MSMapi.MapiS ession")
Set oMessages = CreateObject("MSMapi.MapiM essages")
'Open Session
oSession.LogonUI = True
oSession.SignOn
With oMessages
.SessionID = oSession.SessionID
.MsgIndex = -1
'Activate check adresses
.AddressResolveUI = True
'Receivers
For i = 0 To cTo - 1
.RecipType = 1
.RecipIndex = i
.RecipAddress = rTo(i)
.ResolveName
Next i
'CC's
For i = 0 To cCC - 1
.RecipType = 2
.RecipIndex = i
.RecipAddress = rCc(i)
.ResolveName
Next i
'Subject en messagetext
.MsgSubject = Subject$
.MsgNoteText = Message$ & vbCrLf & Space(cAttach) 'reserve spaces for attachments
'Attachments
For i = 0 To cAttach - 1
.AttachmentIndex = i
.AttachmentPosition = Len(.MsgNoteText) + i - cAttach
.AttachmentPathName = rAttach(i)
Next i
'Send the mail message
.Send
End With
'End session
oSession.SignOff
msg$ = ""
SendMail_Exit:
Set oSession = Nothing
Set oMessages = Nothing
SendMail = msg$
Exit Function
SendMail_Err:
Select Case Err.Number
Case 32001: msg$ = "de gebruiker heeft de opdracht geannuleerd"
Case 32002: msg$ = "er is een onbekende fout opgetreden"
Case 32011: msg$ = "bijlage(n) niet gevonden"
Case Else
RuntimeErr "SendMail"
msg$ = "er is een fout opgetreden"
End Select
Resume SendMail_Exit
End Function
I'm trying to make a function that allows me to send a mapi message but it must not send until the user explicit pushes a send button. Wat i want is that a some kind of dialog (standard oulook sendmail dialog) pops up after the mail has been composed. This will give the user the oppurtunity to check the mail before he sends it himself. Downunder is the code i have so far. This code composes a mapi message but at the end it sends the mail and i can't figure out how to show a sendmail dialog.
thanks,
F.
'-------------------------
' Name : SendMail
' Date : 22-01-1999
' Purpose: This is the front-end function to the MAPISendMail function.
' You pass a semicolon-delimited list of To and CC recipients,
' a subject, a message, and a delimited list of file attachments.
' This function prepares MapiRecip and MapiFile structures with
' the data parsed from the information provided using the
' ParseRecord sub. Once the structures are prepared, the
' MapiSendMail function is called to send the message.
' Comment:
' Input : Subject$ - The text to appear in the subject line of the message
' Receiver$ - Semicolon-delimited list of names to receive the message
' CC$ : Semicolon-delimited list of names to be CC'd
' Attach$: Semicolon-delimited list of files to attach to the message
' Returns: SUCCESS_SUCCESS if successful, or a MAPI error if not.
'-------------------------
Public Function SendMail(ByVal Subject$, ByVal Receiver$, ByVal CC$, ByVal Attach$, ByVal Message$) As String
On Error GoTo SendMail_Err
Dim i, cTo, cCC, cAttach 'variables holding counts
Dim oSession As MAPISession
Dim oMessages As MAPIMessages
Dim msg$
'Count the number of items in each piece of the mail message
cTo = CountTokens(Receiver$, ";")
cCC = CountTokens(CC$, ";")
cAttach = CountTokens(Attach$, ";")
'Create arrays to Receiver$re the semicolon delimited mailing
'information after it is parsed
ReDim rTo(0 To cTo) As String
ReDim rCc(0 To cCC) As String
ReDim rAttach(0 To cAttach) As String
'Parse the semicolon delimited information into the arrays
ParseTokens rTo(), Receiver$, ";"
ParseTokens rCc(), CC$, ";"
ParseTokens rAttach(), Attach$, ";"
'Instantiate Object
Set oSession = CreateObject("MSMapi.MapiS
Set oMessages = CreateObject("MSMapi.MapiM
'Open Session
oSession.LogonUI = True
oSession.SignOn
With oMessages
.SessionID = oSession.SessionID
.MsgIndex = -1
'Activate check adresses
.AddressResolveUI = True
'Receivers
For i = 0 To cTo - 1
.RecipType = 1
.RecipIndex = i
.RecipAddress = rTo(i)
.ResolveName
Next i
'CC's
For i = 0 To cCC - 1
.RecipType = 2
.RecipIndex = i
.RecipAddress = rCc(i)
.ResolveName
Next i
'Subject en messagetext
.MsgSubject = Subject$
.MsgNoteText = Message$ & vbCrLf & Space(cAttach) 'reserve spaces for attachments
'Attachments
For i = 0 To cAttach - 1
.AttachmentIndex = i
.AttachmentPosition = Len(.MsgNoteText) + i - cAttach
.AttachmentPathName = rAttach(i)
Next i
'Send the mail message
.Send
End With
'End session
oSession.SignOff
msg$ = ""
SendMail_Exit:
Set oSession = Nothing
Set oMessages = Nothing
SendMail = msg$
Exit Function
SendMail_Err:
Select Case Err.Number
Case 32001: msg$ = "de gebruiker heeft de opdracht geannuleerd"
Case 32002: msg$ = "er is een onbekende fout opgetreden"
Case 32011: msg$ = "bijlage(n) niet gevonden"
Case Else
RuntimeErr "SendMail"
msg$ = "er is een fout opgetreden"
End Select
Resume SendMail_Exit
End Function
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
shijusn,
Wow ****ing unbelieveble that it just so simple. I don't know how i've could have missed that. You won't believe all the things i have tried to get it to work and i pretty familiar with VB if i say so myself.
thanks,
Wow ****ing unbelieveble that it just so simple. I don't know how i've could have missed that. You won't believe all the things i have tried to get it to work and i pretty familiar with VB if i say so myself.
thanks,
HI wacko41
;-) Thank u for the points lol
;-) Thank u for the points lol
'=================
'Send the mail message
.Send True
'=================