Link to home
Start Free TrialLog in
Avatar of tomcruisew
tomcruisew

asked on

VB60 and E-Mail

How can I send a E-mail from an VB60 application ?

Thanks in advance for any help
Avatar of tcornett
tcornett

Try using the MAPISession and MAPIMessages controls in VB.  If you have the MSDN Library on CD, I believe there are explanations of the many methods, procedures, and events of these controls.  These controls are also only included in the Professional and Enterprise editions of VB6 (Or so I think).  Using these controls would also mean that you would have to have Windows messaging installed and a profile setup in the Mail control panel.  I know this doesn't tell you HOW to send mail in VB, but it points you in the right direction.  Half the fun of programming is learning!  If you have any problems using these controls, post another comment and I'll see if I can help in more detail.

Best Regards,
  - Tom
Also if you have a web server you can use CDONTS to do this as well. A lot less hassle then using MAPIMessages.
ASKER CERTIFIED SOLUTION
Avatar of Plinio
Plinio

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Avatar of Axter
Create a module with the code below.  Then use the SendMail function.

Option Explicit

Const MAPI_Err_FAILURE = 2
Const MAPI_Err_LOGIN_FAILURE = 3
Const MAPI_Err_DISK_FULL = 4
Const MAPI_Err_INSUFFICIENT_MEMORY = 5
Const MAPI_Err_BLK_TOO_SMALL = 6
Const MAPI_Err_TOO_MANY_SESSIONS = 8
Const MAPI_Err_TOO_MANY_FILES = 9
Const MAPI_Err_TOO_MANY_RECIPIENTS = 10
Const MAPI_Err_ATTACHMENT_NOT_FOUND = 11
Const MAPI_Err_ATTACHMENT_OPEN_FAILURE = 12
Const MAPI_Err_ATTACHMENT_WRITE_FAILURE = 13
Const MAPI_Err_UNKNOWN_RECIPIENT = 14
Const MAPI_Err_BAD_RECIPTYPE = 15
Const MAPI_Err_NO_MESSAGES = 16
Const MAPI_Err_INVALID_MESSAGE = 17
Const MAPI_Err_TEXT_TOO_LARGE = 18
Const MAPI_Err_INVALID_SESSION = 19
Const MAPI_Err_TYPE_NOT_SUPPORTED = 20
Const MAPI_Err_AMBIGUOUS_RECIPIENT = 21
Const MAPI_Err_MESSAGE_IN_USE = 22
Const MAPI_Err_NETWORK_FAILURE = 23
Const MAPI_Err_INVALID_EDITFIELDS = 24
Const MAPI_Err_INVALID_RECIPS = 25
Const MAPI_Err_NOT_SUPPORTED = 26

Type MapiMessage
Reserved As Long
Subject As String
NoteText As String
MessageType As String
DateReceived As String
ConversationID As String
Flags As Long
RecipCount As Long
FileCount As Long
End Type

Type MapiRecip
Reserved As Long
RecipClass As Long
Name As String
Address As String
EIDSize As Long
EntryID As String
End Type

Type MapiFile
Reserved As Long
Flags As Long
Position As Long
PathName As String
FileName As String
FileType As String
End Type

Declare Function MAPISendMail32 Lib "MAPI32.DLL" Alias "BMAPISendMail" _
(ByVal Session&, ByVal UIParam&, Message As MapiMessage, _
Recipient() As MapiRecip, File() As MapiFile, ByVal Flags&, _
ByVal Reserved&) As Long

Declare Function MAPISendMail Lib "MAPI.DLL" Alias "BMAPISendMail" ( _
    ByVal Session&, ByVal UIParam&, _
    Message As MapiMessage, _
    Recipient As MapiRecip, File As MapiFile, ByVal Flags&, ByVal Reserved&) As Long

Global Const SUCCESS_SUCCESS = 0
Global Const MAPI_TO = 1
Global Const MAPI_CC = 2
Global Const MAPI_LOGON_UI = &H1

Global DebugVariable As Integer


Sub TestMail()
DebugVariable = DebugVariable + 1
Dim TheMessage As String
Dim Result
TheMessage = "This is a test of the message field"
Result = SendMail("Test number " + Str(DebugVariable), "test@gamemenu.com" _
        , "cc@gamemenu.com", "c:\Autoexec.bat", TheMessage)
 ' Test the result for any errors
If Result <> SUCCESS_SUCCESS Then
    MsgBox "Error sending mail: " & Result, 16, "Mail"
    Else
    MsgBox "Message sent successfully!", 64, "Mail"
    End If
End Sub

Sub Mail()
Dim F As Form, Result
Set F = Screen.ActiveForm
 ' Make sure user has something in the To: box
If IsNull(F!To) Or F!To = "" Then Exit Sub
 ' Make sure no Null values are in the other boxes
If IsNull(F!Subject) Then F!Subject = ""
If IsNull(F!CC) Then F!CC = ""
If IsNull(F!Attach) Then F!Attach = ""
If IsNull(F!Message) Then F!Message = ""
 ' Send the message, passing information from the form
Result = SendMail((F!Subject), (F!To), (F!CC), (F!Attach), (F!Message))
 ' Test the result for any errors
If Result <> SUCCESS_SUCCESS Then
    MsgBox "Error sending mail: " & Result, 16, "Mail"
    Else
    MsgBox "Message sent successfully!", 64, "Mail"
    End If
End Sub

Function SendMail(sSubject As String, sTo As String, sCC As String, sAttach As String, sMessage As String)
Dim i, cTo, cCC, cAttach ' variables holding counts
Dim MAPI_Message As MapiMessage
 ' Count the number of items in each piece of the mail message
cTo = CountTokens(sTo, ";")
cCC = CountTokens(sCC, ";")
cAttach = CountTokens(sAttach, ";")
 ' Create arrays to store 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(), sTo, ";"
ParseTokens rCC(), sCC, ";"
ParseTokens rAttach(), sAttach, ";"
 ' Create the MAPI Recip structure to store all the To and CC
 ' .. information to be passed to the MAPISendMail function
ReDim MAPI_Recip(0 To cTo + cCC) As MapiRecip
 ' Setup the "TO:" recipient structures
For i = 0 To cTo - 1
MAPI_Recip(i).Name = rTo(i)
MAPI_Recip(i).RecipClass = MAPI_TO
Next i
 ' Setup the "CC:" recipient structures
For i = 0 To cCC - 1
MAPI_Recip(cTo + i).Name = rCC(i)
MAPI_Recip(cTo + i).RecipClass = MAPI_CC
Next i
 ' Create the MAPI File structure to store all the file attachment
 ' .. information to be passed to the MAPISendMail function
ReDim MAPI_File(0 To cAttach - 1) As MapiFile
 ' Setup the file attachment structures
MAPI_Message.FileCount = cAttach
For i = 0 To cAttach - 1
MAPI_File(i).Position = 0 'Gives an error if set to -1
MAPI_File(i).PathName = rAttach(i)
MAPI_File(i).FileName = rAttach(i)
Next i
 ' Set the mail message fields
MAPI_Message.Subject = sSubject
MAPI_Message.NoteText = " " + Chr(13) + Chr(10) + sMessage
MAPI_Message.RecipCount = cTo + cCC
 ' Send the mail message
 ' Use MAPISendMail for MAPI.DLL
 ' Use MAPISendMail32 for MAPI32.DLL
SendMail = MAPISendMail32(0&, 0&, MAPI_Message, MAPI_Recip, MAPI_File, MAPI_LOGON_UI, 0&)
End Function

Function CountTokens(ByVal sSource As String, ByVal sDelim As String)
Dim iDelimPos As Integer
Dim iCount As Integer
 ' Number of tokens = 0 if the source string is empty
If sSource = "" Then
CountTokens = 0
 ' Otherwise number of tokens = number of delimiters + 1
Else
iDelimPos = InStr(1, sSource, sDelim)
Do Until iDelimPos = 0
iCount = iCount + 1
iDelimPos = InStr(iDelimPos + 1, sSource, sDelim)
Loop
CountTokens = iCount + 1
End If
End Function

Function GetToken(sSource As String, ByVal sDelim As String) As String
Dim iDelimPos As Integer
 ' Find the first delimiter
iDelimPos = InStr(1, sSource, sDelim)
 ' If no delimiter was found, return the existing string and set
 ' .. the source to an empty string.
If (iDelimPos = 0) Then
GetToken = Trim$(sSource)
sSource = ""
 ' Otherwise, return everything to the left of the delimiter and
 ' .. return the source string with it removed.
Else
GetToken = Trim$(Left$(sSource, iDelimPos - 1))
sSource = Mid$(sSource, iDelimPos + 1)
End If
End Function

Sub ParseTokens(MyArray() As String, ByVal sTokens As String, ByValsDelim As String)
Dim i As Integer
For i = LBound(MyArray) To UBound(MyArray)
    'Had the sDelim as a variable instead of ByValsDelim
    'You should always use "Option Explicit" to avoid this kind of error
    MyArray(i) = GetToken(sTokens, ByValsDelim)
    Next
End Sub