Solved: Sending email from VB app

Do you have MS OutLook installed?

ASKER

Yes, although I've never used it, I installed it Saturday (from ms office 2000 premium). I'd rather do without it if possible, so that users will not need it. btw, I'm with vb5/6.

Éric Moreau

Just find it in VBPJ:

VB4/32, VB5, VB6, VBA
Level: Intermediate

Fill In the E-Mail Fields
ShellExecute is one of the most flexible Win32 APIs. Using ShellExecute, you can pass any filename, and if the file’s extension is associated to a registered program on the user’s machine, the correct application opens and the file is played or displayed.
      In the February 1998 101 Tech Tips supplement, Jose Rodriguez Alvira showed ShellExecute’s Internet power (“Create Internet-Style Hyperlinks”). If you pass an HTTP URL, the user’s default 32-bit Web browser opens and connects to the site. If you pass an e-mail address that has been prefaced with “mailto:”, the user’s default 32-bit e-mail client opens a new e-mail note with the address filled in.
      Here’s how to automatically get a lot more than just the e-mail addresses filled in. If you want to include a list of CC recipients, BCC recipients, or your own subject text or body text, you can create a string variable, add the list of primary addresses (separated by semicolons), then a question mark character and element strings prefaced like this:

For CCs (carbon copies): &CC= (followed by list)
For blind CCs: &BCC= (followed by list)
For subject text: &Subject= (followed by text)
For body text: &Body= (followed by text)
To add an attachment: &Attach= (followed by a valid file path within chr(34)’s)

To use this trick, create a new VB project, add a form, and add six textboxes and a button (cmdSendIt). Paste this into the form’s Declarations section:

Private Declare Function ShellExecute Lib "shell32.dll" _
      Alias "ShellExecuteA" (ByVal hWnd As Long, _
      ByVal lpOperation As String, ByVal lpFile As String, _
      ByVal lpParameters As String, ByVal lpDirectory _
      As String, ByVal nShowCmd As Long) As Long
Private Const SW_SHOWNORMAL = 1

Paste this code into the button’s Click event:

Private Sub cmdSendIt_Click()
      Dim sText As String
      Dim sAddedText As String
      If Len(txtMainAddresses) Then
            sText = txtMainAddresses
      End If
      If Len(txtCC) Then
            sAddedText = sAddedText & "&CC=" & txtCC
      End If
      If Len(txtBCC) Then
            sAddedText = sAddedText & "&BCC=" & txtBCC
      End If
      If Len(txtSubject) Then
            sAddedText = sAddedText & "&Subject=" & txtSubject
      End If
      If Len(txtBody) Then
            sAddedText = sAddedText & "&Body=" & txtBody
      End If
      If Len(txtAttachmentFileLocation) Then
            sAddedText = sAddedText & "&Attach=" & _
                  Chr(34) & txtAttachmentFileLocation & Chr(34)
      End If
      sText = "mailto:" & sText
      ' clean the added elements
      If Len(sAddedText) <> 0 Then
            ' there are added elements, replace the first
            ' ampersand with the question character
            Mid$(sAddedText, 1, 1) = "?"
      End If
      sText = sText & sAddedText
      If Len(sText) Then
            Call ShellExecute(Me.hWnd, "open", sText, _
                  vbNullString, vbNullString, SW_SHOWNORMAL)
      End If
End Sub

You can’t have spaces between the ampersands and tags, or between the tags and the equal signs. You don’t have formatting options, so body text will be one paragraph. However, when you use this technique, program errors are e-mailed to you with full details, and you can create real e-mail applets in a just a few seconds. It beats automating a full e-mail program.
      In addition, almost all this functionality is possible in HTML MailTo tags. Here is a sample:

<A HREF="mailto:smith@smithvoice.com?subject=
Feedback From VisualBasic ett
smithvoice.com/vbfun.htm&CC=smith@smithhome.org&BC
C=fred@fred.net;bill@home.com&body=hello how are
you">feedback@smithvoice</A>

I have yet to get HTML to do the attachments, but attachments are no problem in VB.

Editor’s Note: The full functionality of these extra fields is available in e-mail clients that are totally Exchange-compliant. Some or all of the extra fields might not work with noncompliant e-mail clients.
—Robert Smith, Kirkland, Washington

tward

You can also use the MAPI Controls to do this:

** BEGIN EMAIL.VBP **
Type=Exe
Form=EMail.Frm
Module=Globals; Globals.bas
Module=GetCommandLineArg; ..\..\Modules\GetCommandLineArg\GetCommandLineArg.bas
Object={0BA686C6-F7D3-101A-993E-0000C0EF6F5E}#1.0#0; THREED32.OCX
Object={20C62CAE-15DA-101B-B9A8-444553540000}#1.1#0; MSMAPI32.OCX
IconForm="EMail"
Startup="EMail"
HelpFile=""
Title="EMAIL"
ExeName32="EMail.exe"
Command32="/PATH C:\WINDOWS\TEMP\TEST.LOG /MAIL SomeOne In Address Book"
Name="prjEmail"
HelpContextID="0"
CompatibleMode="0"
MajorVer=1
MinorVer=2
RevisionVer=0
AutoIncrementVer=0
ServerSupportFiles=0
VersionComments=""
VersionCompanyName=""
VersionFileDescription="Email Attachment Program"
VersionLegalCopyright=""
VersionProductName="Email Attachment Program"
CompilationType=0
OptimizationType=0
FavorPentiumPro(tm)=0
CodeViewDebugInfo=0
NoAliasing=0
BoundsCheck=0
OverflowCheck=0
FlPointCheck=0
FDIVCheck=0
UnroundedFP=0
StartMode=0
Unattended=0
Retained=0
ThreadPerObject=0
MaxNumberOfThreads=1
** END EMAIL.VBP **

** BEGIN GLOBALS.BAS **
Attribute VB_Name = "Globals"
Option Explicit

Public Const gVersion As String = " v1.02 "

Public gFromCommandLine As Boolean

Public gPath As String
Public gMail As String

Public gFirstLoad As Boolean
Public Function GetNumberOfRecips(ByVal RecipList As String) As Long

Dim RecipCount As Long
Dim SemiColonPosition As Long

SemiColonPosition = 0
RecipCount = 0

Do

SemiColonPosition = InStr(SemiColonPosition + 1, RecipList, ";", 1)

If SemiColonPosition <> 0 Then

RecipCount = RecipCount + 1

End If

Loop While SemiColonPosition <> 0

GetNumberOfRecips = RecipCount

End Function
Public Function GetRecipName(ByVal RecipList As String, ByVal WhichRecip As Long) As String

Dim CurrentRecip As Long
Dim SemiColonPosition As Long
Dim LastSemiColonPosition As Long
Dim CurrentRecipName As String

LastSemiColonPosition = 1
SemiColonPosition = 0
CurrentRecip = 0

If Right(RecipList, 1) <> ";" Then

RecipList = RecipList & ";"

End If

Do

SemiColonPosition = InStr(LastSemiColonPosition, RecipList, ";", 1)

If SemiColonPosition <> 0 Then

CurrentRecipName = Mid(RecipList, LastSemiColonPosition, SemiColonPosition - LastSemiColonPosition)
CurrentRecip = CurrentRecip + 1
LastSemiColonPosition = SemiColonPosition + 1

End If

Loop While CurrentRecip < WhichRecip

GetRecipName = CurrentRecipName

End Function

Public Function SendAsEmail()

Dim Counter As Long
Dim NumberOfRecips As Long

NumberOfRecips = GetNumberOfRecips(gMail)

EMail.MAPISession1.UserName = "tward"
EMail.MAPISession1.Password = "ultifun"
EMail.MAPISession1.LogonUI = False
EMail.MAPISession1.NewSession = True
EMail.MAPISession1.SignOn

EMail.MAPIMessages1.SessionID = EMail.MAPISession1.SessionID

EMail.MAPIMessages1.Compose

EMail.MAPIMessages1.MsgSubject = "ArcServe Tape Rotation!!"

EMail.MAPIMessages1.MsgNoteText = " "

EMail.MAPIMessages1.AttachmentIndex = 0
EMail.MAPIMessages1.AttachmentPathName = gPath
EMail.MAPIMessages1.AttachmentPosition = 0
EMail.MAPIMessages1.AttachmentType = mapData

Dim Receip As String

For Counter = 0 To NumberOfRecips

EMail.MAPIMessages1.RecipIndex = Counter
EMail.MAPIMessages1.RecipType = mapToList
EMail.MAPIMessages1.RecipDisplayName = GetRecipName(gMail, Counter + 1)
EMail.MAPIMessages1.AddressResolveUI = True
EMail.MAPIMessages1.ResolveName

Next Counter

EMail.MAPIMessages1.Send
EMail.MAPISession1.SignOff

End

End Function
Attribute VB_Name = "Globals"
Option Explicit

Public Const gVersion As String = " v1.02 "

Public gFromCommandLine As Boolean

Public gPath As String
Public gMail As String

Public gFirstLoad As Boolean
Public Function GetNumberOfRecips(ByVal RecipList As String) As Long

Dim RecipCount As Long
Dim SemiColonPosition As Long

SemiColonPosition = 0
RecipCount = 0

Do

SemiColonPosition = InStr(SemiColonPosition + 1, RecipList, ";", 1)

If SemiColonPosition <> 0 Then

RecipCount = RecipCount + 1

End If

Loop While SemiColonPosition <> 0

GetNumberOfRecips = RecipCount

End Function
Public Function GetRecipName(ByVal RecipList As String, ByVal WhichRecip As Long) As String

Dim CurrentRecip As Long
Dim SemiColonPosition As Long
Dim LastSemiColonPosition As Long
Dim CurrentRecipName As String

LastSemiColonPosition = 1
SemiColonPosition = 0
CurrentRecip = 0

If Right(RecipList, 1) <> ";" Then

RecipList = RecipList & ";"

End If

Do

SemiColonPosition = InStr(LastSemiColonPosition, RecipList, ";", 1)

If SemiColonPosition <> 0 Then

CurrentRecipName = Mid(RecipList, LastSemiColonPosition, SemiColonPosition - LastSemiColonPosition)
CurrentRecip = CurrentRecip + 1
LastSemiColonPosition = SemiColonPosition + 1

End If

Loop While CurrentRecip < WhichRecip

GetRecipName = CurrentRecipName

End Function

Public Function SendAsEmail()

Dim Counter As Long
Dim NumberOfRecips As Long

NumberOfRecips = GetNumberOfRecips(gMail)

EMail.MAPISession1.UserName = "NAME"
EMail.MAPISession1.Password = "PASS"
EMail.MAPISession1.LogonUI = False
EMail.MAPISession1.NewSession = True
EMail.MAPISession1.SignOn

EMail.MAPIMessages1.SessionID = EMail.MAPISession1.SessionID

EMail.MAPIMessages1.Compose

EMail.MAPIMessages1.MsgSubject = "ArcServe Tape Rotation!!"

EMail.MAPIMessages1.MsgNoteText = " "

EMail.MAPIMessages1.AttachmentIndex = 0
EMail.MAPIMessages1.AttachmentPathName = gPath
EMail.MAPIMessages1.AttachmentPosition = 0
EMail.MAPIMessages1.AttachmentType = mapData

Dim Receip As String

For Counter = 0 To NumberOfRecips

EMail.MAPIMessages1.RecipIndex = Counter
EMail.MAPIMessages1.RecipType = mapToList
EMail.MAPIMessages1.RecipDisplayName = GetRecipName(gMail, Counter + 1)
EMail.MAPIMessages1.AddressResolveUI = True
EMail.MAPIMessages1.ResolveName

Next Counter

EMail.MAPIMessages1.Send
EMail.MAPISession1.SignOff

End

End Function
** END GLOBALS.BAS **

** BEGIN EMAIL.FRM **
VERSION 5.00
Object = "{20C62CAE-15DA-101B-B9A8-444553540000}#1.1#0"; "MSMAPI32.OCX"
Begin VB.Form EMail
BorderStyle = 1 'Fixed Single
Caption = "EMail Attachment Program"
ClientHeight = 795
ClientLeft = 2175
ClientTop = 3030
ClientWidth = 8700
BeginProperty Font
Name = "Arial"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Icon = "EMail.frx":0000
KeyPreview = -1 'True
LinkTopic = "Form1"
MaxButton = 0 'False
PaletteMode = 1 'UseZOrder
ScaleHeight = 795
ScaleWidth = 8700
Begin MSMAPI.MAPIMessages MAPIMessages1
Left = 120
Top = 120
_ExtentX = 1005
_ExtentY = 1005
_Version = 393216
AddressEditFieldCount= 1
AddressModifiable= 0 'False
AddressResolveUI= 0 'False
FetchSorted = 0 'False
FetchUnreadOnly = 0 'False
End
Begin MSMAPI.MAPISession MAPISession1
Left = 8040
Top = 120
_ExtentX = 1005
_ExtentY = 1005
_Version = 393216
DownloadMail = 0 'False
LogonUI = -1 'True
NewSession = 0 'False
End
End
Attribute VB_Name = "EMail"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Sub Form_Activate()

If gFromCommandLine = True And gFirstLoad = True Then

gFirstLoad = False
Call SendAsEmail

End If

End Sub

Private Sub Form_Load()

EMail.Caption = "EMail Attachment Program" & gVersion

gFirstLoad = True

If Command <> "" Then

gPath = GetCommandLineArgument("/PATH", "/")
gMail = GetCommandLineArgument("/MAIL", "/")

gFromCommandLine = True

Else

End

End If

End Sub
** END EMAIL.FRM **

** BEGIN GETCOMMANDLINEARG.BAS **
Attribute VB_Name = "GetCommandLineArg"
Option Explicit

Public Function GetCommandLineArgument(ByVal Argument As String, ByVal Divider) As String

Dim Counter As Long
Dim ArgumentStart As Long
Dim EndingPosition As Long
Dim ReturnString As String

ReturnString = ""

ArgumentStart = InStr(1, Command, Argument, 1)

If ArgumentStart <> 0 Then

ArgumentStart = ArgumentStart + Len(Argument)

For Counter = ArgumentStart To Len(Command)

If Mid(Command, Counter, 1) = Divider Then

Exit For

End If

Next Counter

ReturnString = Trim(Mid(Command, ArgumentStart, Counter - ArgumentStart))

End If

GetCommandLineArgument = ReturnString

End Function
** END GETCOMMANDLINEARG.BAS **

ADenney

ASKER

I am really impressed with the responses I got. I learned from all of them, and am certainly recommending this site to my friends. Thanks a lot!