Carregar assinatura ao enviar email através do Notes

2024 - VBA & Macros

Post Recente por Ana Carolina Toledo 12 anos atrás

4 Posts

2 Usuários

0 Reactions

1,227 Visualizações

RSS

Ana Carolina Toledo

(@ana-carolina-toledo)

Posts: 11

Active Member

Topic starter

Amigos,

Tenho o seguinte códio que envia email e anexa arquivo porém não carrega assinatura automaticamente. Alguém poderia me ajudar?

Obrigada desde já!!!

Dim oSess As Object
Dim oDB As Object
Dim oDoc As Object
Dim oItem As Object
Dim direct As Object
Dim Var As Variant
Dim flag As Boolean
Dim CtryCd, CtryName, textBody, textBodyF, dSubject As String
Dim recep(20), recepcc(20), recepbcc(20) As Variant
Dim dStyle As Object
Dim nWorks, edDoc, cDb As Object

'CREATE NOTES SESSION OBJECT
Set oSess = CreateObject("Notes.NotesSession")

'INITIALIZE DATABASE
Set oDB = oSess.GETDATABASE("", "")

'OPEN THE MAIL DATABASE
Call oDB.OPENMAIL
flag = True
If Not (oDB.IsOpen) Then
flag = oDB.Open("", "")
End If
If Not flag Then
MsgBox "Can't open mail file: " & oDB.SERVER & " " & oDB.FilePath
End If

'CREATE THE NEW DOCUMENT
Set oDoc = oDB.CREATEDOCUMENT

'APPEND SUBJECT
Call oDoc.AppendItemValue("Subject", dSubject)

'SET DOCUMENT FORMAT TO MEMO
Call oDoc.AppendItemValue("Form", "Memo")

'APPEND RECIPIENT
Call oDoc.AppendItemValue("SendTo", recep)
Call oDoc.AppendItemValue("Copyto", recepcc)
Call oDoc.AppendItemValue("BlindCopyTo", recepbcc)

'CREATE MEMO BODY
Set oItem = oDoc.CREATERICHTEXTITEM("Body")
Set dStyle = oSess.CreateRichTextStyle

'Call edDoc.Save

'APPEND FIRST LINE OF TEXT...UNFORMATTED
oItem.AppendText textBody & Chr(13) & Chr(13)

'Apply formattation and append text of the body
dStyle.Bold = True
dStyle.notescolor = 4
oItem.AppendStyle dStyle
oItem.AppendText textBodyF & Chr(13) & Chr(13)
dStyle.Italic = False
dStyle.Bold = False
dStyle.notescolor = 0
oItem.AppendStyle dStyle
oItem.AppendText textBodyFooter & Chr(13) & Chr(13)

'Attaching file
Call oItem.EmbedObject(1454, "", CtryFilePath)
oDoc.visable = True

'SEND THE EMAIL
oDoc.postdate = Date
oDoc.SaveMessageOnSend = True
Call oDoc.Send(False)

'CLEAN UP
Set dStyle = Nothing
Set oItem = Nothing
Set oDoc = Nothing
Set oDB = Nothing
Set oSess = Nothing

Postado : 27/09/2012 2:38 pm

Fernando Fernandes

(@fernandofernandes)

Posts: 43750

Illustrious Member

Boa noite!!

Veja se ajuda...

'Set up the objects required for Automation into lotus notes
Dim Maildb As Object 'The mail database
Dim UserName As String 'The current users notes name
Dim MailDbName As String 'THe current users notes mail database name
Dim MailDoc As Object 'The mail document itself
Dim AttachME As Object 'The attachment richtextfile object
Dim Session As Object 'The notes session
Dim EmbedObj As Object 'The embedded object (Attachment)
Dim stSignature As String

'Start a session to notes
Set Session = CreateObject("Notes.NotesSession")
'Get the sessions username and then calculate the mail file name
'You may or may not need this as for MailDBname with some systems you
'can pass an empty string
UserName = Session.UserName
MailDbName = Left$(UserName, 1) & Right$(UserName, (Len(UserName) - InStr(1, UserName, " "))) & ".nsf"
'Open the mail database in notes
Set Maildb = Session.GETDATABASE("", MailDbName)
If Maildb.IsOpen = True Then
'Already open for mail
Else
Maildb.OPENMAIL
End If
'Set up the new mail document
Set MailDoc = Maildb.CREATEDOCUMENT
MailDoc.Form = "Memo"

'Attach Your Signature '<------
stSignature = Maildb.GetProfileDocument("CalendarProfile") _
.GetItemValue("Signature")(0)

'MailDoc.Recipient = Recipient
'Addressee = ""
Addressee = ""
Recipient = Split(Addressee, ",")
MailDoc.sendto = Recipient

'MailDoc.Recipient = CopyTo
'MailDoc.copyto = ""

'MailDoc.Recipient = BlindCopyTo
'MailDoc.blindcopyto = ""

'MailDoc.Subject = Subject
MailDoc.Subject = ""
'MailDoc.Body = BodyText
MailDoc.Body = "Hello, Attached you will find a copy of your " & Format(Now() - 30, "mmmm") & " " & Format(Now() - 30, "yyyy") & " Shareholder Servicing Summary. If you have any questions, please contact your Relationship Manager. & stSignature
'MailDoc.SAVEMESSAGEONSEND = SaveIt
MailDoc.SAVEMESSAGEONSEND = True

'Set up the embedded object and attachment and attach it
Attachment = "C:ShareSSSAppleton.xls"
If Attachment <> "" Then
Set AttachME = MailDoc.CREATERICHTEXTITEM("Attachment")
Set EmbedObj = AttachME.EmbedObject(1454, "", Attachment, "Attachment")

End If
'Send the document
MailDoc.SEND 0, Recipient
'Clean Up
Set Maildb = Nothing
Set MailDoc = Nothing
Set AttachME = Nothing
Set Session = Nothing
Set EmbedObj = Nothing

Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel

Postado : 27/09/2012 4:04 pm

Ana Carolina Toledo

(@ana-carolina-toledo)

Posts: 11

Active Member

Topic starter

Oi Alexandre,

Obrigada pelo código mas não está funcionando...

na linha stSignature = Maildb.GetProfileDocument("CalendarProfile").GetItemValue("Signature")(0) a varíavel stSignature não está recebendo valor algum

Alguma outra sugestão?

Não sei se é importante ou não mas a minha assinatura é um arquivo salvo em HTML

Postado : 28/09/2012 11:10 am