Send Mail via VBA

[system]

Further discussion and/or comments on this macro should take place using this topic

Author Notes
SendMail Macro

Author: 2001/11 Durgesh Das/USAN Inc.

1. Send mail Macro is available in the 2 reports SendMail and SendMailPdf attached here with.
2. SendMail Macro in SendMail Report exports the dataproviders as csv file and attaches them to the mail.
3. SendMailPdf Macro in SendMailPdf Report exports the report as pdf file and attaches them to the mail.

You need to have MAPI installed on the BCA Server for the script to run as BCA job. The best scenario is to install Microsoft outlook on the server and create an account .We created an account Bo_admin. That is being used in script to open a MAPI session.

You can copy the script and attach to any of your report but make sure that inside the VBA Editor select Tools->References and select Microsoft CDO1.21 Library before copying the script.

================================
Script is provided “as is” without any warranty, etc. etc…

Durgesh Das 11/09/2001

SendMail

Sub SendMail()

Dim objSession As MAPI.Session ' Local
Dim objMessage As Message  ' local
Dim objRecip As Recipient
On Error GoTo error_olemsg
Dim doc As busobj.IDocument
Dim rep As busobj.Report
Dim DPName As String
Dim test As Boolean

 

Set objSession = CreateObject("MAPI.Session")
objSession.Logon profileName:="bo_admin", newSession:=False, showDialog:=False

If objSession Is Nothing Then
    Err.Raise 10, "MA MACRO", "must first log on; use Session->Logon"
    Exit Sub
    End If

Set objMessage = objSession.Outbox.Messages.Add
If objMessage Is Nothing Then
    Err.Raise 11, "MA MACRO", "could not create a new message in the Outbox"
    Exit Sub
    End If

With objMessage ' message object
     ' Substitue this with your subject
    .Subject = "Resort -Monthly Report"
     ' Substitue with your the message in body part of the mail
    .Text = "The Monthly reports  for " & Format(Now, "mmm") & " is attached herewith."
    For i = 1 To ThisDocument.DataProviders.Count
    If ActiveDocument Is Nothing Then
     MsgBox "NO Active Document to refresh"
  Else
    Set doc = ActiveDocument
   If Not doc.IsAddIn Then
                        
            'use this for converting to csv
            
             DPName = "C:\" + DataProviders.Item(i).Name
            test = DataProviders.Item(i).ConvertTo(boExpAsciiCSV, 1, DPName)
            
            'use this for converting to pdf format
            
            
        Else
    End If
  End If
    Set objAttach = .Attachments.Add ' add the attachment

If objAttach Is Nothing Then
     Err.Raise 12, "MA MACRO", "Unable to create new Attachmentobject"
     Exit Sub
     End If
     
     
     With objAttach
             
        
            .Name = DataProviders.Item(i).Name & ".csv"
            .Source = "C:\" & DataProviders.Item(i).Name & ".csv"
         
     End With
    
  
    .Update ' update message to save attachment in MAPI system

    Next i

    Set objRecip = .Recipients.Add
    With objRecip
        objRecip.Name = ("MAILID") 'substitue with the mailid of the recipient or groupname
        objRecip.Type = CdoTo
        objRecip.Resolve
        End With
            
    ' use this for sending to a recipient as cc
   
   'Set objRecip = .Recipients.Add
    'With objRecip
      ' objRecip.Name = ("ddas")
       'objRecip.Type = CdoCc
       'objRecip.Resolve
       'End With
    

    .Update
    ' update message to save attachment in MAPI system
    .Send showDialog:=False
    End With
    For i = 1 To ThisDocument.DataProviders.Count
     Kill "C:\" & DataProviders.Item(i).Name & ".csv"
   Next i
    objSession.Logoff
    Exit Sub
   
 
error_olemsg:
'MsgBox "Error " & Str(Err) & ": " & Error$(Err)
    Err.Raise 13, "MA MACRO", "Error " & Str(Err) & ": " & Error$(Err)
    Resume Next

End Sub

SendMailPDF

Sub SendMailPDF()

Dim objSession As MAPI.Session ' Local
Dim objMessage As Message  ' local
Dim objRecip As Recipient
On Error GoTo error_olemsg
Dim doc As busobj.IDocument
Dim rep As busobj.Report
Dim DPName As String
Dim test As Boolean

If ActiveDocument Is Nothing Then
     MsgBox "NO Active Document to refresh"
  Else
    Set doc = ActiveDocument
   If Not doc.IsAddIn Then
       ActiveReport.ExportAsPDF ("C:\" & ActiveReport.Name & "_" & Format(Now, "mm_dd_yy") & ".pdf")
    Else
    End If
  End If

Set objSession = CreateObject("MAPI.Session")
'Use a profile which exists on your Exchange Server as mailid.We created bo_admin for ours
objSession.Logon profileName:="bo_admin", newSession:=False, showDialog:=False


If objSession Is Nothing Then
    Err.Raise 10, "MA MACRO", "must first log on; use Session->Logon"
    Exit Sub
    End If

Set objMessage = objSession.Outbox.Messages.Add
If objMessage Is Nothing Then
    Err.Raise 11, "MA MACRO", "could not create a new message in the Outbox"
    Exit Sub
    End If

With objMessage ' message object
    'Substitute with your subject
    .Subject = "Daily  Report"
    'Substitue with your message
    .Text = "The Daily report is attached herewith  "
    .Text = .Text & ActiveReport.Name & "_" & Format(Now, "mm_dd_yy") & ".pdf"
Set objAttach = .Attachments.Add ' add the attachment

If objAttach Is Nothing Then
     Err.Raise 12, "MA MACRO", "Unable to create new Attachmentobject"
     Exit Sub
     End If
     With objAttach
     
             
      .Name = ActiveReport.Name & "_" & Format(Now, "mm_dd_yy") & ".pdf"
      .Source = "C:\" & ActiveReport.Name & "_" & Format(Now, "mm_dd_yy") & ".pdf"
            
     End With
    
  
    .Update ' update message to save attachment in MAPI system

    

    Set objRecip = .Recipients.Add
    With objRecip
        objRecip.Name = ("grpname") 'Substitute with individual mailid or groupname
        objRecip.Type = CdoTo
        objRecip.Resolve
        End With
            
        
    Set objRecip = .Recipients.Add
    With objRecip
       objRecip.Name = ("name") 'Substitute with individual mailid or groupname
       objRecip.Type = CdoCc
       objRecip.Resolve
       End With
    

    .Update
    ' update message to save attachment in MAPI system
    .Send showDialog:=False
    End With
     Kill "C:\" & ActiveReport.Name & "_" & Format(Now, "mm_dd_yy") & ".pdf"
   
    objSession.Logoff
    Exit Sub
   
 
error_olemsg:
'MsgBox "Error " & Str(Err) & ": " & Error$(Err)
    Err.Raise 13, "MA MACRO", "Error " & Str(Err) & ": " & Error$(Err)
    Resume Next

End Sub

SendMail.zip (51.0 KB)

---

BOB Downloads (BOB member since 2003-05-05)