Hello - UPDATE code and information. I continue to play around with this VBA code. I've added below the updated version - This version has lines where I am attempting the ATTACHMENT of an Excel file. The results of this code is that I receive an email but with no attachment. I am not getting any errors so I can't determine where I've gone wrong, hoping someone can review the code and point out where/why the attachment is not happening. Thanks again for all those that are taking a look.
Sub sendingit()
Dim x As Integer
Dim UserName As String
Dim MailDbName As String
Dim Recipient As Variant
Dim Maildb As Object
Dim MailDoc As Object
Dim AttachME As Object
Dim Session As Object
Dim stSignature As String
Dim obAttachment As Object, EmbedObject As Object
Dim stSubject As Variant, stAttachment As String
Const EMBED_ATTACHMENT As Long = 1454
With Application
.ScreenUpdating = False
.DisplayAlerts = False
' Open and locate current LOTUS NOTES User
For x = 2 To Cells(Rows.Count, "A").End(xlUp).Row
If Range("A" & x) = "Reports" Then
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)
Do
stSubject = "File " & Format(Now, "MM-dd-yyyy")
Loop While stSubject = ""
'Retrieve the path and filename of the active workbook.
stAttachment = "C:\Users\jwhite7\Desktop\CurrentEEList\ReportSurvey.xlsx"
'Instantiate the Lotus Notes COM's Objects.
Set noSession = CreateObject("Notes.NotesSession")
Set noDatabase = noSession.GETDATABASE("", "")
If Maildb.IsOpen = True Then
Set noDocument = noDatabase.CREATEDOCUMENT
Set obAttachment = noDocument.CREATERICHTEXTITEM("stAttachment")
Set EmbedObject = obAttachment.EmbedObject(EMBED_ATTACHMENT, "", stAttachment)
Else
Maildb.OPENMAIL
End If
' Create New Mail and Address Title Handlers
Set MailDoc = Maildb.CREATEDOCUMENT
MailDoc.Form = "Memo"
stSignature = Maildb.GetProfileDocument("CalendarProfile").GetItemValue("Signature")(0)
' Select range of e-mail addresses
Recipient = Worksheets("Sheet1").Range("B" & x).Value
MailDoc.SendTo = Recipient
MailDoc.Subject = "URGENT " & Worksheets("Sheet1").Range("C" & x).Value & " NOTIFICATION"
MailDoc.Body = Worksheets("Sheet1").Range("C" & x).Value & " you update your files." & vbCrLf & vbCrLf & stSignature
MailDoc.SaveMessageOnSend = True
MailDoc.PostedDate = Now()
On Error GoTo errorhandler1
MailDoc.SEND 0, Recipient
Set Maildb = Nothing
Set MailDoc = Nothing
Set Session = Nothing
Set EmbedObject = Nothing
Set obAttachment = Nothing
Set noDocument = Nothing
Set noDatabase = Nothing
Set noSession = Nothing
.ScreenUpdating = True
.DisplayAlerts = True
errorhandler1:
Set Maildb = Nothing
Set MailDoc = Nothing
Set Session = Nothing
Set EmbedObject = Nothing
Set obAttachment = Nothing
Set noDocument = Nothing
Set noDatabase = Nothing
Set noSession = Nothing
End If
Next x
End With
End Sub
Bookmarks