Code to send attachments to mail id s listed on excel sheet

[chaitanya051]

Hello,

I got some information on an excel sheet which includes a set of EMail ID s. Now I would like to insert some code ( Macros) into this excel sheet which upon running would send EMails to the people(ID s)listed in the excel sheet. All these EMails should include a predefined subject (present on the excel) and some text in the body along with a couple of attachments. Links(or paths) to all these are provided in the excel sheet. My code takes care of all this i.e it opens the text file from the given link and displays it in the sent mail. It also gathers the listed subject of the mail. But the problem here is that it does not attach the files to the mail being sent.

It just ignores the attachment part.

Im pasting the code i am using here

Please look into it and post your observations

any help would be appreciated

Thanks in advance

Sub MarketGroup()

' setting up various objects
Dim Maildb As Object
Dim UserName As String
Dim MailDbName As String
Dim MailDoc As Object
Dim attachME As Object
Dim Session As Object
Dim EmbedObj1 As Object
Dim recipient As String
Dim ccRecipient As String
Dim bccRecipient As String
Dim subject As String
Dim bodytext As String
Dim Attachment1 As String
Dim Temprecipient As String
Dim iFileNumber As Integer
Dim callDetailsPath As String
Dim mailSentStatus As String
Dim xlApp As New Excel.Application
Dim xlWrkBk As Excel.Workbook
Dim xlSht As Excel.Worksheet
Dim callSummary As String
Dim FileFullPath As String
Dim path As String
Dim arrRecipients As Variant
Dim x As Integer

If MsgBox("Do you want to Proceed?", vbYesNo) = vbYes Then
 
Application.ScreenUpdating = False
Application.EnableEvents = False

path = ActiveWorkbook.FullName
Set xlWrkBk = GetObject(path)
Set xlSht = xlWrkBk.Worksheets(1)

' creating a notes session
Set Session = CreateObject("Notes.NotesSession")
UserName = Session.UserName
MailDbName = Left$(UserName, 1) & Right$(UserName, (Len(UserName) - InStr(1, UserName, " "))) & ".nsf"
Set Maildb = Session.GETDATABASE("", MailDbName)
 

If Maildb.IsOpen <> True Then
On Error Resume Next

Maildb.OPENMAIL
End If

' setting up all sending recipients

x = 2
While Range("B" & x).Text <> ""
    Set MailDoc = Maildb.CreateDocument
    MailDoc.form = "Memo"
    '--- These variables will be used to search for duplicates.
    recipient = Range("B" & x).Text
    Temprecipient = recipient
    '--- Increment X until a different e-mail address is found.
    recipient = Range("B" & x).Text
    arrRecipients = Split(recipient, ",")
    FileFullPath = Range("E" & x).Text
    iFileNumber = FreeFile
    Open FileFullPath For Input As #iFileNumber
    bodytext = Input(LOF(iFileNumber), #iFileNumber)
    Close (iFileNumber)
    
bccRecipient = "abc@xyz.com"
subject = Range("F" & x).Text
mailSentStatus = Range("G" & x).Text
 

'// Lets check to see if form is filled in Min req =Recipient, Subject, Body Text
If recipient = vbNullString Or subject = vbNullString Or bodytext = vbNullString Then
MsgBox "Recipient, Subject and or Body Text is NOT SET!", vbCritical + vbInformation
xlWrkBk.Save
Exit Sub

End If
If mailSentStatus = "NO" Then
' loading the lotus notes e-mail with the inputed data
With MailDoc
.sendto = arrRecipients
.blindcopyto = bccRecipient
.subject = subject
.body = bodytext
End With

' saving message
MailDoc.SaveMessageOnSend = True

callDetailsPath = Range("C" & x).Text
If callDetailsPath <> "" Then
Set attachME = MailDoc.CREATERICHTEXTITEM("callDetailsPath")
Set EmbedObj1 = attachME.EMBEDOBJECT(1454, "", callDetailsPath, "Attachment")
MailDoc.CREATERICHTEXTITEM ("Attachment")
End If


callSummary = Range("D" & x).Text
If callSummary <> "" Then
Set attachME = MailDoc.CREATERICHTEXTITEM("callSummary")
Set EmbedObj1 = attachME.EMBEDOBJECT(1454, "", callSummary, "Attachment")
MailDoc.CREATERICHTEXTITEM ("Attachment")
End If

' send e-mail !!!!
MailDoc.PostedDate = Now()

' if error in attachment or name of recipients
'On Error GoTo errorhandler1
xlSht.Cells(x, "G") = "YES"
MailDoc.Send 0, arrRecipients
End If
x = x + 1
Wend
Application.ScreenUpdating = True
Application.EnableEvents = True
xlWrkBk.Save
Set Maildb = Nothing
Set MailDoc = Nothing
Set attachME = Nothing
Set Session = Nothing
Set EmbedObj1 = Nothing
xlWrkBk.Close

'Unload Me

Exit Sub

' setting up the error message
errorhandler1:

xlWrkBk.Save
MsgBox "Incorrect name supplied or the attachment has not attached," & _
"or your Lotus Notes has not opened correctly. Recommend you open up Lotus Notes" & _
"to ensure the application runs correctly and that a vaild connection exists"

Set Maildb = Nothing
Set MailDoc = Nothing
Set attachME = Nothing
Set Session = Nothing
Set EmbedObj1 = Nothing
xlWrkBk.Close

' unloading the userform
'Unload Me

End If

End Sub