Dim OutlookApp As Object
Dim OutlookMailItem As Outlook.MailItem
Dim OutlookAddressList As Outlook.AddressList
Dim OutlookAddressEntry As Outlook.AddressEntry
Dim MailAttach As String
Dim OutlookNSpace As Outlook.NameSpace
Dim OutlookAttach As Outlook.Attachment
 
MailAttach = "C:\ProjectStatus.xls"
 
 'Send Email using outlook application
 'Note: outlook must be installed on your PC for this module to work:
 '-------------------------------------------------------------------
 Set OutlookApp = New Outlook.Application
 Set OutlookMailItem = OutlookApp.CreateItem(0)
 Set OutlookNSpace = OutlookApp.GetNamespace("MAPI")
 
 
'Get email address from global email address folder
'--------------------------------------------------
For Each OutlookAddressList In OutlookNSpace.AddressLists
    For Each OutlookAddressEntry In OutlookAddressList.AddressEntries
        lvw.ListItems.Add , , OutlookAddressEntry.Name
        lvw.ListItems(lvw.ListItems.Count).SubItems(1) = OutlookAddressEntry.Address
        lvw.ListItems(lvw.ListItems.Count).SubItems(2) = OutlookAddressEntry.ID
        lvw.ListItems(lvw.ListItems.Count).Tag = OutlookAddressEntry.ID
    Next
Next
 
 EmailID = lvw.ListItems(lvw.ListItems.Count).SubItems(1)
 
 If Trim(EmailID) <> "" And Trim(EmailID) Like "*@*.*" Or Trim(EmailID) Like "*@*.com" Then
    GoTo SENDEMAIL
 Else
    MsgBox ("You have entered an invalid email address"), vbCritical, "Email Address Error!"
    Exit Sub
 End If
 
 
SENDEMAIL:
 OutlookMailItem.To = EmailID
 OutlookMailItem.Subject = "Project Status"
 OutlookMailItem.Body = "This is VB email test"
 
 If Not IsMissing(MailAttach) Then
  Set OutlookAttach = OutlookMailItem.Attachments.Add(MailAttach)
 End If
 
 'If Len(MailAttach) > 0 Then
 '   OutlookMailItem.Attachments.Add "C:\ProjectStatus.xls", olByValue, 1, "ProjectStatus"
 'End If
 
 'OutlookMailItem.Display      'To display the email
 OutlookMailItem.Send         'To send the email
 
 Set OutlookApp = Nothing
 Set OutlookMailItem = Nothing