PDA

View Full Version : Issue with sending the active workbook & printscreen via Lotus Notes



ROBJ
12-20-2017, 06:45 PM
Good Day All

The below code sends the active workbook & a printscreen of the current sheet via Lotus Notes. It works perfectly, but I need to distribute to a number of recipients that change from time to time. So I added a "Helper" tab to the workbook, to explain various functions to the end user and include the array of Lotus Notes recipients. I've adapted the code & changed from string to variant for recipients:
Dim vaRecipients As Variant
Dim vaCopyTo As Variant
Dim myArr As Variant
Dim emailto As Variant

'Create the list of recipients.
Set EmailTo = Worksheets("Helper").Range("L13")
Set myArr = Worksheets("Helper").Range("L15:L100")

vaRecipients = EmailTo
vaCopyTo = myArr

but I am getting a runtime error 13 Type mismatch when it arrives to
With NUIDocument
.FieldSetText "EnterSendTo", EmailTo.

Any ideas on how to fix this are greatly appreciate it.
Thank you for your insight.

Fully working code with recipients defined as string :


Public Sub Send_Lotus_Email()

Const EMBED_ATTACHMENT = 1454

Dim NSession As Object
Dim NWorkspace As Object
Dim NMailDb As Object
Dim NUIDocument As Object
Dim NRTattachment As Object
Dim Subject As String
Dim SendTo As String, CopyTo As String
Dim attachmentFile As String
Dim embedCells As Range
Dim CurrentFile As String
Dim lnRetVal As Long

'Check if Lotus Notes is open or not.
lnRetVal = FindWindow("NOTES", vbNullString)

If lnRetVal = 0 Then
MsgBox "Please make sure that Lotus Notes is open!", vbExclamation
Exit Sub
End If
If MsgBox("Are you sending the report?", _
vbOKCancel) = vbCancel Then Exit Sub
'------------ User-defined settings section ------------


SendTo = "yyyyy"
'CopyTo = "***xx"

'Subject = "REPORT" - changed to WB's name... dependant

CurrentFile = Left(ThisWorkbook.Name, (InStrRev(ThisWorkbook.Name, ".", -1, vbTextCompare) - 1))
Subject = CurrentFile
'Subject = ActiveWorkbook.Name - changed to above code to avoid showing file extension


'The cells to be embedded in the email body

Set embedCells = ActiveSheet.Range("A1:M73")

'Optional file attachment - full folder path and file name, or "" for no attachment
'attachmentFile = "C:\path\to\file.xls" - changed for WB full name below
attachmentFile = ActiveWorkbook.FullName
'attachmentFile = "" - needed if no attachment is bein sent

'------------ End of user-defined settings ------------


Set NSession = CreateObject("Notes.NotesSession") 'OLE, late binding only
Set NWorkspace = CreateObject("Notes.NotesUIWorkspace")

Set NMailDb = NSession.GetDatabase("", "")
NMailDb.OpenMail

NWorkspace.ComposeDocument , , "Memo"

Set NUIDocument = NWorkspace.CurrentDocument

With NUIDocument
.FieldSetText "EnterSendTo", SendTo
.FieldSetText "EnterCopyTo", CopyTo
.FieldSetText "EnterBlindCopyTo", ""
.FieldSetText "Subject", Subject
.GotoField "Body"

'------------ Start of email body text ------------

.InsertText "Please see attached report."

'Copy and paste Excel cells as a bitmap image into the email body

.InsertText vbLf & vbLf & "Synopsis:" & vbLf & vbLf
embedCells.CopyPicture , xlBitmap
.Paste
Application.CutCopyMode = False

.InsertText vbLf & vbLf & "Kind regards." & vbLf & vbLf

'------------ End of email body text ------------

'Optional file attachment

If attachmentFile <> "" Then
Set NRTattachment = .Document.CreateRichTextItem("Attachment")
NRTattachment.EmbedObject EMBED_ATTACHMENT, "", attachmentFile
End If

.Save
.Close
End With

'Send S key to click the 'Send and Save' button to send mail document

Application.Wait DateAdd("s", 2, Now)
AppActivate "Send Mail", True
SendKeys "S"

Set NUIDocument = Nothing
Set NWorkspace = Nothing
Set NMailDb = Nothing
Set NSession = Nothing
MsgBox "The e-mail has successfully been created and distributed", vbInformation
End Sub

MINCUS1308
12-21-2017, 06:24 AM
You set the variable to the range, but not the values in the range? Is that a thing that I just didn't know vba could do?
I tested this concept:

Set EmailTo = Worksheets("Helper").Range("L13")

By putting some names in the range and attempted to msgbox them out:

Sub test()
Set c = Sheet1.Range("E15:E17")
MsgBox c
End Sub
I also received a type mismatch.

I think you need to step through your range and compile a string and then set your SendTo Variable

I may be wrong but I think the base of the problem is that you're trying to set a string variable to a range.

MINCUS1308
12-21-2017, 06:42 AM
In the past I have achieved a similar task using the following tid-bit of code



'.... I cut out the first part of the sub :p
Dim MAILTOstr As String
'SELECT THE EMAIL LIST SHEET
Sheet2.Select
'COMPILE THE MAILTO VARIABLE USING THE "SEND TO:" LIST
For I = 4 To 18 'STEP THROUGH LIST OF EMAIL ADDRESSES
If Cells(I, 2).Value = "" Then GoTo SkipThisLine
MAILTOstr = Cells(I, 2).Value & "; " & MAILTOstr
SkipThisLine:
Next I

MINCUS1308
12-21-2017, 06:54 AM
if you don't know the length of the list you could also try this:

Sub Testing()
Dim MAILTOstr As String
i = 1
Do While Sheet1.Cells(i, 1).Value <> ""
MAILTOstr = Cells(i, 1).Value & "; " & MAILTOstr
i = i + 1
Loop

MsgBox MAILTOstr
End Sub

MINCUS1308
12-21-2017, 07:12 AM
And if youre expecting some blank lines in your list you could use this:

Sub TestingTesting()
Dim MAILTOstr As String
i = 1
MyBlankCounter = 0
KeepGoing = True
Do While KeepGoing
If Cells(i, 1).Value <> "" Then
MAILTOstr = Cells(i, 1).Value & "; " & MAILTOstr
MyBlankCounter = 0
Else
MyBlankCounter = MyBlankCounter + 1
End If
If MyBlankCounter > 10 Then GoTo here:
i = i + 1
Loop
here:
MsgBox MAILTOstr
End Sub

MINCUS1308
12-21-2017, 08:51 AM
AHHH I'm dumb. well kinda...


Dim SendTo As String
you don't want a string.
you want an array with strings in it

Dim SendTo()

ROBJ
12-21-2017, 08:52 PM
Hi Mincus

Thank you for your assistance. I am still at odds with the code (then again, VBA is not one of my strengths)... the annoying thing is that I have a similar file where the code (to send the active sheet) does take the array with no issues & although I tried to "merge" the code, I keep getting the type mismatch errors. I'll post below the 2nd code. As I said both work perfectly individually, it's just that for the 1st file I need the array of recipients from the Helper worksheet rather then the current string.
2nd file (sends active sheet) working code:


Sub SendActiveSheet()

Dim stFileName As String
Dim vaRecipients As Variant
Dim noSession As Object
Dim noDatabase As Object
Dim noDocument As Object
Dim noEmbedObject As Object
Dim noAttachment As Object
Dim stAttachment As String
Dim EMBED_ATTACHMENT As Long
Dim bodytext As Variant
Dim vaCopyTo As Variant
Dim myArr As Variant
Dim emailto As Variant
Dim wb1 As Workbook, wb2 As Workbook
Dim stSubject As String
Dim vDay As Integer

If MsgBox("Are you sure you want to send this report?", _
vbOKCancel) = vbCancel Then Exit Sub

Application.DisplayAlerts = False

ActiveWorkbook.Unprotect Password:=PW

Select Case ActiveSheet.Range("T12").Value
Case 1
vDay = 1
Case 2
vDay = 2
Case 3
vDay = 3
Case 4
vDay = 4
Case 5
vDay = 5
Case 6
vDay = 6
Case 7
vDay = 7
Case 8
vDay = 8
Case 9
vDay = 9
Case 10
vDay = 10
Case 11
vDay = 11
Case 12
vDay = 12
Case 13
vDay = 13
Case 14
vDay = 14
Case 15
vDay = 15
Case 16
vDay = 16
Case 17
vDay = 17
Case 18
vDay = 18
Case 19
vDay = 19
Case 20
vDay = 20
Case Else
vDay = 0
End Select

EMBED_ATTACHMENT = 1454

bodytext = "Good Morning," & vbNewLine _
& vbNewLine _
& "Attached above is the report" & vbNewLine _
& vbNewLine _
& vbNewLine & "Thanks," & vbNewLine _
& vbNewLine _
& vbNewLine & "Your Team" & vbNewLine _
& vbNewLine _
& "This is a system generated email" & vbNewLine _

Set wb1 = ThisWorkbook
stSubject = "Daily Report - Day " & vDay

' If MsgBox("Are you sure you want to send this email?", vbYesNo) = vbYes Then

'Copy the active sheet to a new temporary workbook.
With ActiveSheet
.Copy
stFileName = "Daily Report.xlsm"
End With

stAttachment = stPath & stFileName '& ".xlsm"
'Save and close the temporarily workbook.

Set wb2 = ActiveWorkbook

wb2.ActiveSheet.Unprotect Password:=PW

With wb1.ActiveSheet
.Unprotect Password:=PW
.Range("A1:U200").Copy Destination:=wb2.ActiveSheet.Range("A1")
.Protect Password:=PW, _
DrawingObjects:=True, _
Contents:=True, _
Scenarios:=True, _
AllowFormattingCells:=True, _
AllowFormattingColumns:=True, _
AllowFormattingRows:=True
.EnableSelection = xlNoRestrictions
End With

With wb2
.SaveAs stAttachment, FileFormat:=52
.Close
End With

'Create the list of recipients.
Set emailto = Worksheets("Setup").Range("F13")
Set myArr = Worksheets("Setup").Range("F15:F31")

vaRecipients = emailto
vaCopyTo = myArr

'Instantiate 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

'Create the e-mail and the attachment.
Set noDocument = noDatabase.CREATEDOCUMENT
Set noAttachment = noDocument.CREATERICHTEXTITEM("stAttachment")
Set noEmbedObject = noAttachment.EmbedObject(EMBED_ATTACHMENT, "", stAttachment)

'Add values to the created e-mail main properties.
With noDocument
.Form = "Memo"
.SendTo = vaRecipients
.CopyTo = vaCopyTo
.Subject = stSubject
.Body = bodytext
.SaveMessageOnSend = False
.PostedDate = Now()
.Send 0, vaRecipients
End With

ActiveWorkbook.Protect Structure:=True, Windows:=False, Password:=PW

'Delete the temporarily workbook.
Kill stAttachment
'Release objects from memory.
Set noEmbedObject = Nothing
Set noAttachment = Nothing
Set noDocument = Nothing
Set noDatabase = Nothing
Set noSession = Nothing

MsgBox "The Report has been successfully detached and e-mailed", _
vbInformation
' End If

Application.DisplayAlerts = True

End Sub