Changing a Macro from Lotus to Outlook 2016

[hailno]

Hi All,

With a great deal of help from this forum I put together the following which allows me to send multiple emails to a list of addresses including a reference in the subject line and a set text in the message body. The problem I have is that I have moved from Lotus Notes to Outlook and, not being great at this, I’m unable to make the macro work. I’d massively appreciate any help any of you can give:

Sub TestingLotusNotesEmail()

Dim noSession As Object, noDatabase As Object, noDocument As Object
Dim obAttachment As Object, EmbedObject As Object

Dim stSubject As Variant, stAttachment As String

Dim vaRecipient As Variant, vaMsg As Variant

Dim Btext As String

Const EMBED_ATTACHMENT As Long = 1454


'Retrieve the path and filename of the active workbook.

stAttachment = ActiveWorkbook.FullName


'Initiate the Lotus Notes COM's Objects.

Set noSession = CreateObject("Notes.NotesSession")

Set noDatabase = noSession.GETDATABASE("", "")


'If Lotus Notes is not open then open the mail-part of it.

If noDatabase.IsOpen = False Then noDatabase.OPENMAIL


For i = 1 To 100

zSendTo = Sheet1.Cells(i, "B")

zRefs = Sheet1.Cells(i, "A") & " " & Sheet2.Range("B1")

xRefs = Sheet2.Range("A1")



'Create the e-mail and the attachment.

Set noDocument = noDatabase.CreateDocument

Set obAttachment = noDocument.CreateRichTextItem("stAttachment")

'Add values to the created e-mail main properties.
With noDocument

.Form = "Memo"

.SendTo = zSendTo

.Subject = "" & zRefs

.Body = xRefs

.SaveMessageOnSend = True

End With


'Send the e-mail.

With noDocument

.PostedDate = Now()

.Send 0, vaRecipient

End With



Next i


'Release objects from the memory.

Set EmbedObject = Nothing

Set obAttachment = Nothing

Set noDocument = Nothing

Set noDatabase = Nothing

Set noSession = Nothing


'Activate Excel for the user.

AppActivate "Microsoft Excel"

MsgBox "The e-mail has successfully been created and distributed.", vbInformation


End Sub

Thanks in advance

Hailno

 

[Jerry Sullivan]

I'd suggest you adapt one of the examples posted on Ron de Bruin's site.

Mail from Excel and make/mail PDF files (Windows)

Just ask if you get stuck and want some help.

 

[hailno]

I'd suggest you adapt one of the examples posted on Ron de Bruin's site.

Mail from Excel and make/mail PDF files (Windows)

Just ask if you get stuck and want some help.

Hi Jerry,

That's fantastic, many thanks. I've put together the following based on that site and all works, the only thing I'm struggling with is making the subject contain both the standard text in sheet 2 as well as the unique reference in sheet 1 which corresponds with the email address.

In the Lotus version this was covered by the Zrefs. In this one I can get the subject to populate with the standard text only- .

Subject = Sheet2.Range("B1")

but as soon as I try and modify to also include:

Sheet1.Cells(i, "A") & " " & Sheet2.Range("B1")

Then the subject goes completely blank.

Hope this makes sense and that you're able to help and again, many thanks. For reference the full details are as follows:

Sub Test1()
    Dim OutApp As Object
    Dim OutMail As Object
    Dim cell As Range
    Application.ScreenUpdating = False
    Set OutApp = CreateObject("Outlook.Application")
    On Error GoTo cleanup
    For Each cell In Columns("B").Cells.SpecialCells(xlCellTypeConstants)
        
            Set OutMail = OutApp.CreateItem(0)
            On Error Resume Next
            With OutMail
                .To = cell.Value
                .Subject = Sheet1.Cells(i, "A") & " " & Sheet2.Range("B1")
                .Body = Sheet2.Range("A1")
                .Send
            End With
            On Error GoTo 0
            Set OutMail = Nothing
            Next cell
cleanup:
    Set OutApp = Nothing
    Application.ScreenUpdating = True
End Sub

Many thanks

Hailno

 

[Jerry Sullivan]

Hi Hailno,

One problem is that this statement is using the variable "i", but that isn't declared or assigned a value.

.Subject = Sheet1.Cells(i, "A") & " " & Sheet2.Range("B1")

If i represents the Row of the "cell" variable currently being processed, you could revise that to...

.Subject = Sheet1.Cells([B]cell.Row[/B], "A") & " " & Sheet2.Range("B1")

It would best to reference the intended sheet in this statement...

For Each cell In Columns("B").Cells.SpecialCells(xlCellTypeConstants)

Without that, Excel defaults to the ActiveSheet, which sometimes isn't the sheet you intended to reference.

 

[hailno]

Hi Hailno,

One problem is that this statement is using the variable "i", but that isn't declared or assigned a value.

.Subject = Sheet1.Cells(i, "A") & " " & Sheet2.Range("B1")

If i represents the Row of the "cell" variable currently being processed, you could revise that to...

.Subject = Sheet1.Cells([B]cell.Row[/B], "A") & " " & Sheet2.Range("B1")

It would best to reference the intended sheet in this statement...

For Each cell In Columns("B").Cells.SpecialCells(xlCellTypeConstants)

Without that, Excel defaults to the ActiveSheet, which sometimes isn't the sheet you intended to reference.

Hi Jerry,

Ah, I see- that worked perfectly.

Thanks again for all of your help and have a great day.

 

[hailno]

Hi All,

Sorry, seems I have another problem with this. Although it works perfectly if I manually type in the email address required, if I try and use email addresses pulled from a separate tab using VLOOKUP it doesn't seem to recognise these email addresses and nothing will send. Does anyone have any ideas please? For reference I'm using the following:

Sub Test1()
Dim OutApp As Object
Dim OutMail As Object
Dim cell As Range
Application.ScreenUpdating = False
Set OutApp = CreateObject("Outlook.Application")
On Error GoTo cleanup
For Each cell In Columns("B").Cells.SpecialCells(xlCellTypeConstants)

Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.To = cell.Value
.Subject = Sheet1.Cells(cell.Row, "A") & " " & Sheet2.Range("B1")
.Body = Sheet2.Range("A1")
.SentOnBehalfOfName = """Kiran"" <NGELINE.S.LIV.EXD@nykgroup.com>"
.Send
End With
On Error GoTo 0
Set OutMail = Nothing
Next cell
cleanup:
Set OutApp = Nothing
Application.ScreenUpdating = True
End Sub


Many thanks
hailno

 

[Jerry Sullivan]

Hi hailno,

I don't see in your code where you are trying to do a VLOOKUP to another sheet.

Please post info on the sheet name and range of the lookup table, and the column number within that range that has the email addresses.