1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109
| Private ogwApp As GroupwareTypeLibrary.Application
Private ogwRootAcct As GroupwareTypeLibrary.Account
Private 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)
'Author : Ken Puls (www.excelguru.ca)
'Macro purpose: To stand as a self contained procedure for creating and
' sending an email via groupwise
'NOTE: You can feed a comma separated string of address to all
' address and attachment fields
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
'Subject & body
.Subject = sSubject
.BodyText = sBody
'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
'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
.Display
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
Sub SendMyMail()
Call Email_Via_Groupwise("TEST", _
"test@test.com", _
"This is a test email", _
"I hope you enjoy it!", _
"")
End Sub |
Partager