repeterende email verzenden via Outlook in VBA

[susanthuis]

Beste helpmijers,

In Excel 2003 heb ik een macro die voorheen via Groupwise de emails automatisch verzond, maar nu Microsoft Outlook 2010 er is, kan ik het programma niet meer gebruiken. Het programma luidt:

ption Explicit
Private ogwApp As GroupwareTypeLibrary.Application
Private ogwRootAcct As GroupwareTypeLibrary.account

Public Sub Email_Via_Groupwise(sLoginName As String, _
sEmailTo As String, _
sSubject As String, _
sBody As String, _
Optional sAttachments As String, _
Optional sEmailCC As String, _
Optional sEmailBCC As String)
On Error GoTo EarlyExit

'Required variable declarations
Const NGW$ = "NGW"
Dim ogwNewMessage As GroupwareTypeLibrary.Mail
Dim aryTo() As String, _
aryCC() As String, _
aryBCC() As String, _
aryAttach() As String
Dim lAryElement As Long

'Split the emails into an array if necessary
aryTo = Split(sEmailTo, ",")
aryCC = Split(sEmailCC, ",")
aryBCC = Split(sEmailBCC, ",")
aryAttach = Split(sAttachments, ",")

'Set application object reference if needed
Application.StatusBar = "Logging in to email account..."
If ogwApp Is Nothing Then
DoEvents
Set ogwApp = CreateObject("NovellGroupWareSession")
DoEvents
End If

'Login to root account if required
If ogwRootAcct Is Nothing Then
Set ogwRootAcct = ogwApp.Login(sLoginName, vbNullString, _
, egwPromptIfNeeded)
DoEvents
End If

'Create new message
Application.StatusBar = "Building email to " & sEmailTo & "..."
Set ogwNewMessage = ogwRootAcct.WorkFolder.Messages.Add _
("GW.MESSAGE.MAIL", egwDraft)
DoEvents

'Assign message properties
With ogwNewMessage
'To field
For lAryElement = 0 To UBound(aryTo())
.Recipients.Add aryTo(lAryElement), NGW, egwTo
Next lAryElement

'CC Field
For lAryElement = 0 To UBound(aryCC())
.Recipients.Add aryCC(lAryElement), NGW, egwCC
Next lAryElement

'BCC Field
For lAryElement = 0 To UBound(aryBCC())
.Recipients.Add aryBCC(lAryElement), NGW, egwBC
Next lAryElement

'Subject & body
.Subject = sSubject
.BodyText = sBody

'Attachments (if any)
For lAryElement = 0 To UBound(aryAttach())
If Not aryAttach(lAryElement) = vbNullString Then _
.Attachments.Add aryAttach(lAryElement)
Next lAryElement

'Send the message (Sending may fail if recipients don't resolve)
On Error Resume Next
.Send
DoEvents
If Err.Number = 0 Then Application.StatusBar = "Message sent!" _
Else: Application.StatusBar = "Email to " & sEmailTo & " failed!"
On Error GoTo 0
End With

EarlyExit:
'Release all variables
Set ogwNewMessage = Nothing
Set ogwRootAcct = Nothing
Set ogwApp = Nothing
DoEvents
Application.StatusBar = False
End Sub



Groet en dank alvast,

Susan