T
Ticotion
Hi
I have a workbook that when I press a button needs to e-mail the active
sheet or workbook as an attachment from Lotus Notes. I use the following
code, but can not get the attachmentstrig to work. Any ideas?
Sub Send_Excel_Cell_Content_To_Lotus_Notes2()
Dim noSession As Object, noDatabase As Object, noDocument As Object
Dim obAttachment As Object, EmbedObject As Object
Dim stSubject As Variant
Dim stAttachment As String
Dim vaRecipient As Variant, vaMsg As Variant
Const EMBED_ATTACHMENT As Long = 1454
' Starts the For Next loop to assign variable email target
For e = 1 To 9
If e = 1 Then vaRecipient = Sheets("E-mail").Range("A1").Value
If e = 2 Then vaRecipient = Sheets("E-mail").Range("A2").Value
If e = 3 Then vaRecipient = Sheets("E-mail").Range("A3").Value
If e = 4 Then vaRecipient = Sheets("E-mail").Range("A4").Value
If e = 5 Then vaRecipient = Sheets("E-mail").Range("A5").Value
If e = 6 Then vaRecipient = Sheets("E-mail").Range("A6").Value
If e = 7 Then vaRecipient = Sheets("E-mail").Range("A7").Value
If e = 8 Then vaRecipient = Sheets("E-mail").Range("A8").Value
If e = 9 Then vaRecipient = Sheets("E-mail").Range("A9").Value
On Error Resume Next
vaMsg = "THIS AN AUTOMATED EMAIL ----- Please find attached the Factory
dashboard ref for last week and the new prioritising for the coming week."
stSubject = "*** Factory Dash Board ref ***"
stAttachment = ActiveSheet & ".xls"
'("Depart overview.xls").Sheets("Overview")
'"N:\01_Fabriksinformation\08_Ledergruppe\05_Dokumentation\01_SIM\01_Weekly_Manager_meeting\Manager meeting 2010 " & strDate & ".xls"
'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 obAttachment = noDocument.CreateRichTextItem("stAttachment")
Set EmbedObject = obAttachment.EmbedObject(EMBED_ATTACHMENT, "",
stAttachment)
'Add values to the created e-mail main properties.
With noDocument
.Form = "Memo"
.SendTo = vaRecipient
.Subject = stSubject
.Body = vaMsg
.SaveMessageOnSend = True
End With
'Send the e-mail.
With noDocument
.PostedDate = Now()
.Send 0, vaRecipient
End With
Next e
End
SendMailError:
Dim Msg
Msg = "Error # " & Str(Err.Number) & " was generated by " _
& Err.Source & Chr(13) & Err.Description
MsgBox Msg, , "Error", Err.HelpFile, Err.HelpContext
'SendMail = False
End Sub
I have a workbook that when I press a button needs to e-mail the active
sheet or workbook as an attachment from Lotus Notes. I use the following
code, but can not get the attachmentstrig to work. Any ideas?
Sub Send_Excel_Cell_Content_To_Lotus_Notes2()
Dim noSession As Object, noDatabase As Object, noDocument As Object
Dim obAttachment As Object, EmbedObject As Object
Dim stSubject As Variant
Dim stAttachment As String
Dim vaRecipient As Variant, vaMsg As Variant
Const EMBED_ATTACHMENT As Long = 1454
' Starts the For Next loop to assign variable email target
For e = 1 To 9
If e = 1 Then vaRecipient = Sheets("E-mail").Range("A1").Value
If e = 2 Then vaRecipient = Sheets("E-mail").Range("A2").Value
If e = 3 Then vaRecipient = Sheets("E-mail").Range("A3").Value
If e = 4 Then vaRecipient = Sheets("E-mail").Range("A4").Value
If e = 5 Then vaRecipient = Sheets("E-mail").Range("A5").Value
If e = 6 Then vaRecipient = Sheets("E-mail").Range("A6").Value
If e = 7 Then vaRecipient = Sheets("E-mail").Range("A7").Value
If e = 8 Then vaRecipient = Sheets("E-mail").Range("A8").Value
If e = 9 Then vaRecipient = Sheets("E-mail").Range("A9").Value
On Error Resume Next
vaMsg = "THIS AN AUTOMATED EMAIL ----- Please find attached the Factory
dashboard ref for last week and the new prioritising for the coming week."
stSubject = "*** Factory Dash Board ref ***"
stAttachment = ActiveSheet & ".xls"
'("Depart overview.xls").Sheets("Overview")
'"N:\01_Fabriksinformation\08_Ledergruppe\05_Dokumentation\01_SIM\01_Weekly_Manager_meeting\Manager meeting 2010 " & strDate & ".xls"
'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 obAttachment = noDocument.CreateRichTextItem("stAttachment")
Set EmbedObject = obAttachment.EmbedObject(EMBED_ATTACHMENT, "",
stAttachment)
'Add values to the created e-mail main properties.
With noDocument
.Form = "Memo"
.SendTo = vaRecipient
.Subject = stSubject
.Body = vaMsg
.SaveMessageOnSend = True
End With
'Send the e-mail.
With noDocument
.PostedDate = Now()
.Send 0, vaRecipient
End With
Next e
End
SendMailError:
Dim Msg
Msg = "Error # " & Str(Err.Number) & " was generated by " _
& Err.Source & Chr(13) & Err.Description
MsgBox Msg, , "Error", Err.HelpFile, Err.HelpContext
'SendMail = False
End Sub