Email from excel via Lotus Notes

[gaz_chops]

I managed to find this piece of code on this site, which I thought (hoped) I might be able to adapt, one huge problem is that I have never used vb???
What I need to do is send an email to each of the house no.s (as per the excel example, but without the leading alpha character) and populate the ????in the vb with the "Model/Item"......any help would be hugely welcome

Thanks
Gaz

Sub SendNotesMail()
Dim Maildb As Object, UserName As String, MailDbName As String
Dim MailDoc As Object, Session As Object
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
Else: Maildb.OpenMail
End If
Set MailDoc = Maildb.CreateDocument
MailDoc.Form = "Memo"
MailDoc.SendTo = "0504" 'Nickname or full address
'MailDoc.CopyTo = 'whomever
'MailDoc.BlindCopyTo = Whomever
MailDoc.Subject = "Machine Change"
MailDoc.Body = _
Replace("As a result of a review of your AWP collections that I have carried out,@@I have asked Leisure Link to replace your ????? AWP.@@@@I or your Leisure Link Business Account Manager will try @@to phone you to discuss this within the next couple of days.@@However if you have any immediate comments,@@please do not hesitate to contact either of us." _
& Join(Application.Transpose(Range([b5], [b65536].End(3))), "@") _
& "@@With kind regards", "@", vbCrLf)
MailDoc.SaveMessageOnSend = True
MailDoc.PostedDate = Now
On Error GoTo Audi
Call MailDoc.Send(False)
Set Maildb = Nothing: Set MailDoc = Nothing: Set Session = Nothing
Exit Sub
Audi:
Set Maildb = Nothing: Set MailDoc = Nothing: Set Session = Nothing
End Sub

PCIMIS Notes.xls
	A	B	C	D
1	HseNo'	Model/Item	Recommendation
2	C0504	25NOTERUNNER	changetoJacktheKipper
3	C3223	25ROYALROULETTE	ANBdropping-changetoSuperstars/TopDog/HiFlyer
4	C1228	25HYPNOTIC	ChangeHypnotic-urgent
5	S5564	25TOPDOG	ChangetoBubble&Squeak/Jackpot&Beanstreak Changestilloutstanding
6	S5564	25CASHEXPLOSION	noedcsinceinstall-pleasecheck.Stillnoedcbeingreceivedpleasedealwith ChangetoMonopoly/Dambusters changestilloutstanding
7	S5564	25DO$HNPECKS	ChangeQualityStreak/Superstars/Dambuster
8	C3253	25CASHBANGWALLOP	ChangetoJumpinJokersorcashExplosionon82%
9	S9135	25JACKPOTANDTHEBEANSTREAK	ChangeANBdropping-injectionplease
Sheet1

 

[NateO]

Looks like something I might have posted... Which columns are you sending? This is looking at column B...

Try the following:

Sub SendNotesMail()
Dim Maildb As Object, UserName As String, MailDbName As String
Dim MailDoc As Object, Session As Object
Dim myArr As Variant, i As Long
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
    Else: Maildb.OpenMail
End If
Set MailDoc = Maildb.CreateDocument
MailDoc.Form = "Memo"
MailDoc.SendTo = "0504" 'Nickname or full address
'MailDoc.CopyTo = Whomever
'MailDoc.BlindCopyTo = Whomever
MailDoc.Subject = "Machine Change"
myArr = Range([a2], [a65536].End(3))
For i = LBound(myArr) To UBound(myArr)
    myArr(i) = Right(myArr(i), Len(myArr(i)) - 1)
Next
MailDoc.Body = _
    Replace("As a result of a review of your AWP collections that" & _
        "I have carried out,@@I have asked Leisure Link to replace your ????? " & _
        "AWP.@@@@I or your Leisure Link Business Account Manager will try" & _
        "@@to phone you to discuss this within the next couple of days." & _
        "@@However if you have any immediate comments,@@please do not " & _
        "hesitate to contact either of us." & _
        Join(Application.Transpose(myArr), "@") & _
        "@@With kind regards", "@", vbCrLf)
MailDoc.SaveMessageOnSend = True
MailDoc.PostedDate = Now
On Error GoTo Audi
Call MailDoc.Send(False)
Set Maildb = Nothing:    Set MailDoc = Nothing:    Set Session = Nothing
Exit Sub
Audi:
Set Maildb = Nothing:    Set MailDoc = Nothing:    Set Session = Nothing
End Sub

This is untested.

 

[gaz_chops]

Nate,
Thanks for your response, i'm on a course for a couple of days so won't be able to look at till the weekend.
Thanks again.

Gaz

 

[NateO]

Thanks for your response, i'm on a course for a couple of days so won't be able to look at till the weekend.

It's too cold to golf in Minneapolis right now, I envy you.

You are welcome.

 

[gaz_chops]

If only?!? Unfortunately it was a course on Performance Development Reviews not a Golf course?

Gaz
I'll post back later when I have tried the code you posted.

 

[gaz_chops]

Nate,
What I am after is a seperate email to each of the House No.s in column A (minus the leading alpha character), each email will then contain the Name of the Model/Item that appears next to it in column B within the text

"As a result of a review of your AWP collections that" & _
"I have carried out,@@I have asked Leisure Link to replace your £25 NOTE RUNNER " & _
"AWP.@@@@I or your Leisure Link Business Account Manager will try" & _
"@@to phone you to discuss this within the next couple of days." & _
"@@However if you have any immediate comments,@@please do not " & _
"hesitate to contact either of us." & _
Join(Application.Transpose(myArr), "@") & _

to House 0504
ps with the code you posted I keep getting a pop up message at the point :-

myArr(i) = Right(myArr(i), Len(myArr(i)) - 1)
Next

Run time error '9'
Subscript out of range

Rgaerds
Gaz

 

[NateO]

Hello, I can't speak to your error based on your post.

Try:

<font face=Courier New><SPAN style="color:darkblue">Sub</SPAN> SendNotesMail()
<SPAN style="color:darkblue">Dim</SPAN> Maildb <SPAN style="color:darkblue">As</SPAN> <SPAN style="color:darkblue">Object</SPAN>, UserName <SPAN style="color:darkblue">As</SPAN> <SPAN style="color:darkblue">String</SPAN>, MailDbName <SPAN style="color:darkblue">As</SPAN> <SPAN style="color:darkblue">String</SPAN>
<SPAN style="color:darkblue">Dim</SPAN> MailDoc <SPAN style="color:darkblue">As</SPAN> <SPAN style="color:darkblue">Object</SPAN>, Session <SPAN style="color:darkblue">As</SPAN> <SPAN style="color:darkblue">Object</SPAN>
<SPAN style="color:darkblue">Dim</SPAN> cl <SPAN style="color:darkblue">As</SPAN> Range
<SPAN style="color:darkblue">Set</SPAN> Session = CreateObject("Notes.NotesSession")
UserName = Session.UserName
MailDbName = Left$(UserName, 1) & Right$(UserName, _
    (Len(UserName) - InStr(1, UserName, " "))) & ".nsf"
<SPAN style="color:darkblue">Set</SPAN> Maildb = Session.GetDatabase("", MailDbName)
<SPAN style="color:darkblue">If</SPAN> <SPAN style="color:darkblue">Not</SPAN> Maildb.IsOpen <SPAN style="color:darkblue">Then</SPAN> Maildb.OpenMail
<SPAN style="color:darkblue">For</SPAN> <SPAN style="color:darkblue">Each</SPAN> cl <SPAN style="color:darkblue">In</SPAN> Range([a2], [a65536].End(3))
    <SPAN style="color:darkblue">Set</SPAN> MailDoc = Maildb.CreateDocument
    MailDoc.Form = "Memo"
    MailDoc.SendTo = Right$(cl, Len(cl) - 1) <SPAN style="color:green">'Nickname or full address</SPAN>
    <SPAN style="color:green">'MailDoc.CopyTo = Whomever</SPAN>
    <SPAN style="color:green">'MailDoc.BlindCopyTo = Whomever</SPAN>
    MailDoc.Subject = "Machine Change"
    MailDoc.Body = _
        Replace("As a result of a review of your AWP collections that" & _
            "I have carried out,@@I have asked Leisure Link to replace your ????? " & _
            "AWP.@@@@I or your Leisure Link Business Account Manager will try" & _
            "@@to phone you to discuss this within the next couple of days." & _
            "@@However if you have any immediate comments,@@please do not " & _
            "hesitate to contact either of us." & _
            cl(, 2) & vbNewLine & cl(, 3) & _
            "@@With kind regards", "@", vbCrLf)
    MailDoc.SaveMessageOnSend = <SPAN style="color:darkblue">True</SPAN>
    MailDoc.PostedDate = Now
    <SPAN style="color:darkblue">On</SPAN> <SPAN style="color:darkblue">Error</SPAN> <SPAN style="color:darkblue">GoTo</SPAN> Audi
    <SPAN style="color:darkblue">Call</SPAN> MailDoc.Send(False)
Audi: <SPAN style="color:darkblue">On</SPAN> <SPAN style="color:darkblue">Error</SPAN> <SPAN style="color:darkblue">GoTo</SPAN> 0
<SPAN style="color:darkblue">Next</SPAN>
Session.Quit
<SPAN style="color:darkblue">Set</SPAN> Maildb = Nothing:    <SPAN style="color:darkblue">Set</SPAN> MailDoc = Nothing:    <SPAN style="color:darkblue">Set</SPAN> Session = <SPAN style="color:darkblue">Nothing</SPAN>
<SPAN style="color:darkblue">End</SPAN> <SPAN style="color:darkblue">Sub</SPAN></FONT>

I have not tested this for a variety of reasons.

 

[gaz_chops]

Nate,
Changed the code slightly to put the Model/Item in a diff place, it generates all of the emails but does not populate the mail to with the House No. in Col A?

Sub SendNotesMail()
Dim Maildb As Object, UserName As String, MailDbName As String
Dim MailDoc As Object, Session As Object
Dim cl As Range
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 Not Maildb.IsOpen Then Maildb.OpenMail
For Each cl In Range([a2], [a65536].End(3))
Set MailDoc = Maildb.CreateDocument
MailDoc.Form = "Memo"
MailDoc.SendTo = Right$(cl, Len(cl) - 1) 'Nickname or full address
'MailDoc.CopyTo = Whomever
'MailDoc.BlindCopyTo = Whomever
MailDoc.Subject = "Machine Change"
MailDoc.Body = _
Replace("As a result of a review of your AWP collections that" & _
"I have carried out,@@I have asked Leisure Link to replace your " & _
cl(, 2) & _
" AWP.@@@@I or your Leisure Link Business Account Manager will try" & _
"@@to phone you to discuss this within the next couple of days." & _
"@@However if you have any immediate comments,@@please do not " & _
"hesitate to contact either of us." & _
"@@With kind regards", "@", vbCrLf)
MailDoc.SaveMessageOnSend = True
MailDoc.PostedDate = Now
On Error GoTo Audi
Call MailDoc.Send(False)
Audi: On Error GoTo 0
Next
Session.Quit
Set Maildb = Nothing: Set MailDoc = Nothing: Set Session = Nothing
End Sub

Thanks
Gaz

 

[gaz_chops]

Nate,
Thanks a million it works like a dream. It did post to the house number, what I didn't realise is that we add the word "unit" after the number as the email address.

Again thanks
Gaz

 

[NateO]

Yep, just concatenate the word unit to results of the right(cl...) function in the MailDoc.SendTo line.

You are welcome.