N1ck9141
04-01-2016, 03:49 AM
Hi Guys sorry I am pretty new to VB and have edited some code i found online to send emails via lotus notes but having trouble making the next change the current code is below. :banghead:
Sub SendEmailUsingCOM()
'*************************************************************
'*************************************************************
Dim nSess As Object 'NotesSession
Dim nDir As Object 'NotesDbDirectory
Dim nDb As Object 'NotesDatabase
Dim nDoc As Object 'NotesDocument
Dim nAtt As Object 'NotesRichTextItem
Dim vToList As Variant, vBCCList As Variant, vBody As Variant
Dim vbAtt As VbMsgBoxResult
Dim sFilPath As String
Dim sPwd As String
'*************************************************************
'*************************************************************
Set nSess = CreateObject("Lotus.NotesSession") 'New:{29131539-2EED-1069-BF5D-00DD011186B7}
'*************************************************************
'*************************************************************
sPwd = Application.InputBox("Type your Lotus Notes password!", Type:=2)
Call nSess.Initialize(sPwd)
Set nDir = nSess.GetDbDirectory("")
Set nDb = nDir.OpenMailDatabase
Set nDoc = nDb.CreateDocument
'*************************************************************
'*************************************************************
vToList = Application.Transpose(Range("A1").Resize(Range("A" & Rows.Count).End(xlUp).Row).Value)
vBCCList = Application.Transpose(Range("B1").Resize(Range("B" & Rows.Count).End(xlUp).Row).Value)
'*************************************************************
'*************************************************************
With nDoc
Set nAtt = .CreateRichTextItem("Body")
Call .ReplaceItemValue("Form", "Memo")
Call .ReplaceItemValue("Subject", "Lotus Notes Email")
With nAtt
.AppendText (Range("C2").Value)
'Decide if you want to attach a file.
vbAtt = MsgBox("Do you want to attach document?", vbYesNo, "Attach Document")
Select Case vbAtt
Case 6
.AddNewLine
.AppendText ("********************************************************************")
.AddNewLine
sFilPath = Application.GetOpenFilename
Call .EmbedObject(1454, "", sFilPath) '1454 = Constant for EMBED_ATTACHMENT
Case 7
'Do Nothing
End Select
End With
Call .ReplaceItemValue("CopyTo", vBCCList)
Call .ReplaceItemValue("PostedDate", Now())
Call .Send(False, vToList)
End With
End Sub
It works great but i want to make two changes to it,
Firstly rather then sending the email to everyone in column "A" and CC "B"
I want it to send each new line as a new email.
So first email to the address in A2 and B2
second email to the address in A3 and B3 etc...
Secondly rather than a pop up box to add attachment, the file path for the attached will be in column D for that email.
In conclusion the code will create an email for each line,
TO address in Column "A"
CC Address in Column "B"
Body of Text in Column "C"
Attachment source in Column "D"
Thank you for your help in advance.
Sub SendEmailUsingCOM()
'*************************************************************
'*************************************************************
Dim nSess As Object 'NotesSession
Dim nDir As Object 'NotesDbDirectory
Dim nDb As Object 'NotesDatabase
Dim nDoc As Object 'NotesDocument
Dim nAtt As Object 'NotesRichTextItem
Dim vToList As Variant, vBCCList As Variant, vBody As Variant
Dim vbAtt As VbMsgBoxResult
Dim sFilPath As String
Dim sPwd As String
'*************************************************************
'*************************************************************
Set nSess = CreateObject("Lotus.NotesSession") 'New:{29131539-2EED-1069-BF5D-00DD011186B7}
'*************************************************************
'*************************************************************
sPwd = Application.InputBox("Type your Lotus Notes password!", Type:=2)
Call nSess.Initialize(sPwd)
Set nDir = nSess.GetDbDirectory("")
Set nDb = nDir.OpenMailDatabase
Set nDoc = nDb.CreateDocument
'*************************************************************
'*************************************************************
vToList = Application.Transpose(Range("A1").Resize(Range("A" & Rows.Count).End(xlUp).Row).Value)
vBCCList = Application.Transpose(Range("B1").Resize(Range("B" & Rows.Count).End(xlUp).Row).Value)
'*************************************************************
'*************************************************************
With nDoc
Set nAtt = .CreateRichTextItem("Body")
Call .ReplaceItemValue("Form", "Memo")
Call .ReplaceItemValue("Subject", "Lotus Notes Email")
With nAtt
.AppendText (Range("C2").Value)
'Decide if you want to attach a file.
vbAtt = MsgBox("Do you want to attach document?", vbYesNo, "Attach Document")
Select Case vbAtt
Case 6
.AddNewLine
.AppendText ("********************************************************************")
.AddNewLine
sFilPath = Application.GetOpenFilename
Call .EmbedObject(1454, "", sFilPath) '1454 = Constant for EMBED_ATTACHMENT
Case 7
'Do Nothing
End Select
End With
Call .ReplaceItemValue("CopyTo", vBCCList)
Call .ReplaceItemValue("PostedDate", Now())
Call .Send(False, vToList)
End With
End Sub
It works great but i want to make two changes to it,
Firstly rather then sending the email to everyone in column "A" and CC "B"
I want it to send each new line as a new email.
So first email to the address in A2 and B2
second email to the address in A3 and B3 etc...
Secondly rather than a pop up box to add attachment, the file path for the attached will be in column D for that email.
In conclusion the code will create an email for each line,
TO address in Column "A"
CC Address in Column "B"
Body of Text in Column "C"
Attachment source in Column "D"
Thank you for your help in advance.