Cambiar mi macro de Notes a outlook

1 post / 0 nuevos
tetorin
Imagen de tetorin
Offline
última acción: Hace 7 meses 2 horas
Nivel 1 - 200 puntosNivel 2 - 500 puntosNivel 3 - 1000 puntosNivel 4 - 2000 puntos
alta: 26/05/2011 - 02:57
Puntos: 3262
Cambiar mi macro de Notes a outlook

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

 

Etiquetas: