Buen Dia aTodos
Tengo esta macro que manda Mails en lotus Not
Como la modifico para que trabaje con Outlook
Saludos...
Sub Lotus()
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 MyRange As String
Dim MyRange2 As String
Dim MyRange3 As String
Dim MyRange4 As String
Dim MyRange5 As String
Dim MyRange6 As String
Dim MyMail As String
Dim MyMail1 As String
Dim MyMail2 As String
Dim MyMail3 As String
Dim MyMail4 As String
Dim recip(5) As Variant
MyMail1 = Range("AG3").Value
MyMail2 = Range("AG4").Value
MyMail3 = Range("AG5").Value
MyMail4 = Range("AG6").Value
recip(0) = "someone@someone.com"
recip(1) = "john.doe@someone.com"
recip(2) = MyMail1
recip(3) = MyMail2
recip(4) = MyMail3
recip(5) = MyMail4
Set oSess = CreateObject("Notes.NotesSession")
Set oDB = oSess.GETDATABASE("", "")
Call oDB.OPENMAIL
flag = True
If Not (oDB.IsOpen) Then flag = oDB.Open("", "")
If Not flag Then
MsgBox "Can't open mail file: " & oDB.SERVER & " " & oDB.FILEPATH
GoTo exit_SendAttachment
End If
On Error GoTo err_handler
'Building Message
Set oDoc = oDB.CREATEDOCUMENT
Set oItem = oDoc.CREATERICHTEXTITEM("BODY")
oDoc.Form = "Memo"
oDoc.Subject = "NADRUKORDER"
oDoc.Sendto = recip
oDoc.Body = ""
oDoc.postdate = Date
oDoc.SaveMessageOnSend = True
MyRange = Range("S14").Value
MyRange2 = Range("S32").Value
MyRange3 = Range("S33").Value
MyRange4 = Range("S34").Value
MyRange5 = Range("S35").Value
MyRange6 = Range("S36").Value
'Attaching DATABASE
Call oItem.EmbedObject(1454, "", MyRange)
Call oItem.EmbedObject(1454, "", MyRange2)
Call oItem.EmbedObject(1454, "", MyRange3)
Call oItem.EmbedObject(1454, "", MyRange4)
Call oItem.EmbedObject(1454, "", MyRange5)
Call oItem.EmbedObject(1454, "", MyRange6)
oDoc.visable = True
'Sending Message
oDoc.Send False
exit_SendAttachment:
On Error Resume Next
Set oSess = Nothing
Set oDB = Nothing
Set oDoc = Nothing
Set oItem = Nothing
'Done
Exit Sub
err_handler:
If Err.Number = 7225 Then
MsgBox "Bestand bestaat niet"
Else
MsgBox Err.Number & " " & Err.Description
End If
On Error GoTo exit_SendAttachment
End Sub