Solved

Send mail form Excel using Visual Basic

Posted on 2001-06-19
17
370 Views
Last Modified: 2013-11-25
How can I send a mail from Excel? I mean wryly send it, not just showing the mail-sending dialog. This should work so, that I have to set the parameters from VB code (address, attachment, subject, CC: etc), then send the mail. Is it any solution to this?
0
Comment
Question by:octi
  • 8
  • 5
  • 2
  • +2
17 Comments
 
LVL 49

Expert Comment

by:Ryan Chong
ID: 6205325
Hi octi, u can use the outlook object to send the mail, then attach the Excel file as an attachment/ or body?

See this sample: Control Outlook from Excel
http://www.erlandsendata.no/english/vba/ole/controloutlook.htm
0
 

Expert Comment

by:ie1978
ID: 6205446
This should do it, if you don't want an attatchment just delete the relevant lines of code

Cheers

ie

Sub SendMessage(AttachmentPath)
         
    Dim objOutlook As Outlook.Application
    Dim objOutlookMsg As Outlook.MailItem
    Dim objOutlookRecip As Outlook.Recipient
    Dim objOutlookAttach As Outlook.Attachment
    Dim dDate As Date
   
    On Error GoTo fail
   
    Set objOutlook = CreateObject("Outlook.Application")

    Set objOutlookMsg = objOutlook.CreateItem(olMailItem)

    dDate = Now

    With objOutlookMsg
        Set objOutlookRecip = .Recipients.Add("e-mail address")
        objOutlookRecip.Type = olTo
       
        Set objOutlookRecip = .Recipients.Add("e-mail address")
        objOutlookRecip.Type = olTo
       
        Set objOutlookRecip = .Recipients.Add("e-mail address")
        objOutlookRecip.Type = olTo
       
        Set objOutlookRecip = .Recipients.Add("type e-mail address")
        objOutlookRecip.Type = olTo
       
        Set objOutlookRecip = .Recipients.Add("asaldanha@fandc.co.uk")
        objOutlookRecip.Type = olTo
       
        .Subject = "Volatility Prediction"
        .Body = "Volatility Prediction for " & Space(1) & dDate & vbCrLf & vbCrLf
        .Importance = olImportanceHigh  'High importance

        If Not IsMissing(AttachmentPath) Then
            Set objOutlookAttach = .Attachments.Add(AttachmentPath)
        End If

        For Each objOutlookRecip In .Recipients
            objOutlookRecip.Resolve
        Next
       
       .Send

    End With
       
    Set objOutlook = Nothing

Exit Sub

fail:
    MsgBox "E-mail has failed", vbExclamation

End Sub
0
 

Expert Comment

by:ie1978
ID: 6205454
Guess I should explain it.

.subject   is the subject of the e-mail
.body      is the body of the e-mail

obviously, u don't need to send it to as many people as I have...used this code only last week :)

if you need any more help pls ask

Cheers

ie
0
 

Author Comment

by:octi
ID: 6205560
The solutions are not working because references missing from the Outlook objects. The other problem is, that if I use on other default mailer (Netscape), this samples are unusable.
Thanks,
       Br. Attila
0
 
LVL 1

Accepted Solution

by:
mcbeth earned 200 total points
ID: 6205812
Try this.. You'll need to reference MS CDO Object. The Class use the CDO Object to send your Mail. To Add Attachments create a new Function like Recipient.
Run StartMapiSession to Logon to your Mail Account. Your standard profile comes from the reg.

Option Explicit
Private Type OSVERSIONINFO
   dwOSVersionInfoSize As Long
   dwMajorVersion As Long
   dwMinorVersion As Long
   dwBuildNumber As Long
   dwPlatformId As Long
   szCSDVersion As String * 128
End Type

Enum eDialog
    ShowDialog = True
    HideDialog = False
End Enum

Enum eSession
    NewSession = True
    NoNewSession = False
End Enum

Const REG_SZ As Long = 1
Const REG_DWORD As Long = 4
Const HKEY_CURRENT_USER = &H80000001
Const ERROR_NONE = 0
Const ERROR_BADDB = 1
Const ERROR_BADKEY = 2
Const ERROR_CANTOPEN = 3
Const ERROR_CANTREAD = 4
Const ERROR_CANTWRITE = 5
Const ERROR_OUTOFMEMORY = 6
Const ERROR_INVALID_PARAMETER = 7
Const ERROR_ACCESS_DENIED = 8
Const ERROR_INVALID_PARAMETERS = 87
Const ERROR_NO_MORE_ITEMS = 259
Const KEY_ALL_ACCESS = &H3F
Const REG_OPTION_NON_VOLATILE = 0

Dim oSession As MAPI.Session
Dim oMessage As MAPI.Message
Dim oRecipient As MAPI.Recipient
Dim oAttachment As MAPI.Attachment
Dim oStore As MAPI.InfoStore
Dim isRunning As Boolean

Dim lzMailCC As String
Dim lzMailSubject As String
Dim lzMailText As String



Private Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" (ByRef lpVersionInformation As OSVERSIONINFO) As Long
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Private Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, phkResult As Long) As Long
Private Declare Function RegQueryValueExString Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, ByVal lpData As String, lpcbData As Long) As Long
Private Declare Function RegQueryValueExLong Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Long, lpcbData As Long) As Long
Private Declare Function RegQueryValueExNULL Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, ByVal lpData As Long, lpcbData As Long) As Long



Public Sub EndMapiSession()
oSession.Logoff
isRunning = False
End Sub

Public Sub MailSubject(pzSubject As String)
lzMailSubject = pzSubject
End Sub

Public Sub MailText(pzText As String)
lzMailText = pzText
End Sub


Private Function QueryValue(sKeyName As String, sValueName As String)
Dim lRetVal As Long     'result of the API functions
Dim hKey As Long        'handle of opened key
Dim vValue As Variant   'setting of queried value

lRetVal = RegOpenKeyEx(HKEY_CURRENT_USER, sKeyName, 0, KEY_ALL_ACCESS, hKey)
lRetVal = QueryValueEx(hKey, sValueName, vValue)
QueryValue = vValue
RegCloseKey (hKey)
End Function
Private Function QueryValueEx(ByVal lhKey As Long, ByVal szValueName As String, vValue As Variant) As Long
Dim cch As Long
Dim lrc As Long
Dim lType As Long
Dim lValue As Long
Dim sValue As String

On Error GoTo QueryValueExError

' Determine the size and type of data to be read
lrc = RegQueryValueExNULL(lhKey, szValueName, 0&, lType, 0&, cch)
If lrc <> ERROR_NONE Then Error 5

Select Case lType
   ' For strings
   Case REG_SZ:
      sValue = String(cch, 0)
      lrc = RegQueryValueExString(lhKey, szValueName, 0&, lType, sValue, cch)
      If lrc = ERROR_NONE Then
         vValue = Left$(sValue, cch)
      Else
         vValue = Empty
      End If
   ' For DWORDS
   Case REG_DWORD:
      lrc = RegQueryValueExLong(lhKey, szValueName, 0&, lType, lValue, cch)
      If lrc = ERROR_NONE Then vValue = lValue
   Case Else
      'all other data types not supported
      lrc = -1
End Select

QueryValueExExit:
         QueryValueEx = lrc
         Exit Function
QueryValueExError:
         Resume QueryValueExExit
End Function


Public Function SessionRunning() As Boolean
SessionRunning = isRunning
End Function

Public Function SetRecipient(lzRecipient As String) As Long
On Error GoTo ErrorHandler
If Not isRunning Then
    SetRecipient = -1
    Exit Function
End If
Set oRecipient = oMessage.Recipients.Add
oRecipient.Name = lzRecipient
oRecipient.Type = ActMsgTo
oRecipient.Resolve

SetRecipient = 0
Exit Function

ErrorHandler:
    SetRecipient = Err
End Function


Public Function StartMapiSession(Optional Profile As String, Optional nDialog As eDialog, Optional nSession As eSession) As Long
Dim retValue As Long
Dim lzProfile As String

If Len(Profile) < 1 Then
    retValue = GetDefaultProfile(lzProfile)
    If retValue <> 0 Then
        StartMapiSession = -1
        Exit Function
    End If
Else
    lzProfile = Profile
End If

Set oSession = CreateObject("MAPI.Session")
On Error Resume Next
If nDialog = ShowDialog Then
    oSession.Logon ShowDialog:=True, NewSession:=nSession
Else
    oSession.Logon lzProfile, ShowDialog:=False, NewSession:=nSession
End If
If Err <> 0 Then
    StartMapiSession = Err
    Exit Function
End If
Set oMessage = oSession.Outbox.Messages.Add
If Err <> 0 Then
    StartMapiSession = Err
    Exit Function
End If
StartMapiSession = 0
isRunning = True
End Function

Private Function GetDefaultProfile(ByRef lzProfile As String) As Long
Dim osInfo As OSVERSIONINFO
Dim retValue As Integer
Dim sKeyName As String
Dim sValueName As String
Dim sDefaultUserProfile As String
osInfo.dwOSVersionInfoSize = 148
osInfo.szCSDVersion = Space(128)
retValue = GetVersionEx(osInfo)
Select Case osInfo.dwPlatformId
Case 0 'Keine Info
    GetDefaultProfile = -1
    Exit Function
Case 1 ' Win95
    sKeyName = "Software\Microsoft\Windows Messaging Subsystem\Profiles"
Case 2 ' Win NT
    sKeyName = "Software\Microsoft\Windows NT\CurrentVersion\Windows Messaging Subsystem\Profiles"
End Select

sValueName = "DefaultProfile"
sDefaultUserProfile = QueryValue(sKeyName, sValueName)
lzProfile = sDefaultUserProfile
GetDefaultProfile = 0
End Function


Private Sub Class_Initialize()
isRunning = False
End Sub


Public Function CreateMessage(nImportance As ActMsgImportance) As Long
On Error GoTo ErrorHandler
If Not isRunning Then
    CreateMessage = -1
    Exit Function
End If
oMessage.Importance = nImportance
oMessage.Subject = lzMailSubject
oMessage.Text = lzMailText
oMessage.Update
oMessage.Send ShowDialog:=False
CreateMessage = 0
Exit Function

ErrorHandler:
    CreateMessage = Err
End Function

Private Sub Class_Terminate()
If isRunning Then oSession.Logoff
End Sub


0
 

Author Comment

by:octi
ID: 6206062
Thanks for your answer mcbeth, but what you wrote there is a list of functions. I can't use it in excel as a macro, and I still don't konw how to send a mail.
0
 
LVL 1

Expert Comment

by:mcbeth
ID: 6206113
Sorry but you can (thanks to VBA). If you don't won't to put the code into excel, create an ActiveX DLL (the code is ready to use). Add a reference to the dll and all you need is :
Sub Macroxy()
Dim xMail As New cMAIL
xMail.startmapisession
lpResult = xMail.SetRecipient(<email_address>)
xMail.MailText <BOdyText>
xMail.CreateMessage ActMsgHigh
xMail.EndMapiSession
end sub
0
 
LVL 69

Expert Comment

by:Éric Moreau
ID: 6206218
Download the free vbSendMail from http://www.freevbcode.com/ShowCode.Asp?ID=109
0
How to run any project with ease

Manage projects of all sizes how you want. Great for personal to-do lists, project milestones, team priorities and launch plans.
- Combine task lists, docs, spreadsheets, and chat in one
- View and edit from mobile/offline
- Cut down on emails

 

Author Comment

by:octi
ID: 6206499
mcbeth>
In the VBA of my excel the Enum type is not recognized. Is there a problem with my excel version? I use Excel 8.0.

0
 
LVL 1

Expert Comment

by:mcbeth
ID: 6206633
>octi

just replace enum in functionheader and delete enums

Public Function StartMapiSession(Optional Profile As String, Optional nDialog As boolean, Optional nSession
As boolean) As Long

---------------------------------------------------
nDialog = true ( Show Dialog for Profile)
nSession = true (CreateNewSession)
0
 

Author Comment

by:octi
ID: 6206819
mcbeth>
This types are not recognized in Excel VBA
 octi

MAPI.Session
MAPI.Message
MAPI.Recipient
MAPI.Attachment
MAPI.InfoStore
0
 
LVL 1

Expert Comment

by:mcbeth
ID: 6206879
you have to reference the CDO Objects to your Excel Macro
if you are still in vba mode enter menu extra and click Reference. There you'll find Microsoft CDO for Windows 2000 Libraray. Add to code and excel vba will recognized it. btw.. it's a better way to download the file emoreau
posted. If you use vbsendmail you do not have to install any mailclient on your workstation to send mails... :-)
0
 

Author Comment

by:octi
ID: 6206973
I have NT 4.0.
For me, your solution is better, becase I must use a certain mail client.
0
 
LVL 1

Expert Comment

by:mcbeth
ID: 6207019
octi>
for NT 4 you have to reference

Active messaging Object Libraray

( its a former version
of the CDO Objects).

good luck...
0
 

Author Comment

by:octi
ID: 6272449
mcbeth>
How can I make an instance of the cMail class from your exemple? Where is declared this? It gives me a compile error.
0
 

Author Comment

by:octi
ID: 6272474
emoreau>
Sorry, but that solution with the free dll is not portable.
Beside this it's redundant. Why to make such dll if already exist in windows?
0
 

Author Comment

by:octi
ID: 6272598
emoreau>
Sorry, but that solution with the free dll is not portable.
Beside this it's redundant. Why to make such dll if already exist in windows?
0

Featured Post

How to run any project with ease

Manage projects of all sizes how you want. Great for personal to-do lists, project milestones, team priorities and launch plans.
- Combine task lists, docs, spreadsheets, and chat in one
- View and edit from mobile/offline
- Cut down on emails

Join & Write a Comment

You can of course define an array to hold data that is of a particular type like an array of Strings to hold customer names or an array of Doubles to hold customer sales, but what do you do if you want to coordinate that data? This article describes…
Since upgrading to Office 2013 or higher installing the Smart Indenter addin will fail. This article will explain how to install it so it will work regardless of the Office version installed.
This lesson covers basic error handling code in Microsoft Excel using VBA. This is the first lesson in a 3-part series that uses code to loop through an Excel spreadsheet in VBA and then fix errors, taking advantage of error handling code. This l…
This is Part 3 in a 3-part series on Experts Exchange to discuss error handling in VBA code written for Excel. Part 1 of this series discussed basic error handling code using VBA. http://www.experts-exchange.com/videos/1478/Excel-Error-Handlin…

708 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

17 Experts available now in Live!

Get 1:1 Help Now