Modificación macro para envío de correro - de groupwise a outlook

[PabloSeo]

Bue dia, necesito modificar la macro que se detalla a continuación, en el trabajo nos migraron de Groupwise a Outlook y la persona que la realizo no está más.

Option Explicit

Private ogwApp As GroupwareTypeLibrary.Application

Private ogwRootAcct As GroupwareTypeLibrary.account

Sub Email_Multiple_Users_Via_Groupwise()

'Macro purpose: To stand as a self contained procedure for creating and

'sending an email to multiple users (if required)

'This code requires:

' -A reference to the Groupware Type Library

' -The following 2 lines declared at the beginning of the MODULE:

' Private ogwApp As GroupwareTypeLibrary.Application

' Private ogwRootAcct As GroupwareTypeLibrary.account

' -The following named ranges on the spreadsheet

' Email_To

' Email_CC

' Email_BC

'SECTION 1

'Declare all required variables

Const NGW$ = "NGW"

Dim ogwNewMessage As GroupwareTypeLibrary.Mail

Dim StrLoginName As String, _

StrMailPassword As String, _

StrSubject As String, _

StrBody As String, _

strAttachFullPathName As String, _

sCommandOptions As String, _

cl As Range

'SECTION 2

'Set all required variables

StrLoginName = Range("Login").Value

StrMailPassword = "abc123"

StrSubject = Range("Subject").Value

StrBody = "Para vuestra info." & vbCrLf & _

"Saludos."

strAttachFullPathName = Range("Dir").Value

'SECTION 3

'Create the Groupwise object and login in to Groupwise

'Set application object reference if needed

If ogwApp Is Nothing Then 'Need to set object reference

DoEvents

Set ogwApp = CreateObject("NovellGroupWareSession")

DoEvents

End If

If ogwRootAcct Is Nothing Then 'Need to log in

'Login to root account

If Len(StrMailPassword) Then 'Password was passed, so use it

sCommandOptions = "/pwd=" & StrMailPassword

Else 'Password was not passed

sCommandOptions = vbNullString

End If

Set ogwRootAcct = ogwApp.Login(StrLoginName, sCommandOptions, _

, egwPromptIfNeeded)

DoEvents

End If

'SECTION 4

'Create and Send the Message

'Create new message

Set ogwNewMessage = ogwRootAcct.WorkFolder.Messages.Add _

("GW.MESSAGE.MAIL", egwDraft)

DoEvents

'Assign "To" recipients

For Each cl In ActiveSheet.Range("Email_To")

If Not cl.Value = "" Then ogwNewMessage.Recipients.Add cl.Value, NGW, egwTo

Next cl

'Assign "CC" recipients

For Each cl In ActiveSheet.Range("Email_CC")

If Not cl.Value = "" Then ogwNewMessage.Recipients.Add cl.Value, NGW, egwCC

Next cl

'Assign "BC" recipients

For Each cl In ActiveSheet.Range("Email_BC")

If Not cl.Value = "" Then ogwNewMessage.Recipients.Add cl.Value, NGW, egwBC

Next cl

With ogwNewMessage

'Assign the SUBJECT text

If Not StrSubject = "" Then .Subject = StrSubject

'Assign the BODY text

If Not StrBody = "" Then .BodyText = StrBody

'Assign Attachment(s)

If Not strAttachFullPathName = "" Then .Attachments.Add strAttachFullPathName

'Send the message

On Error Resume Next

'Send method may fail if recipients don't resolve

.Send

DoEvents

On Error GoTo 0

End With

'SECTION 5

'Release all variables

Set ogwNewMessage = Nothing

Set ogwRootAcct = Nothing

Set ogwApp = Nothing

DoEvents

End Sub