pmcelhany
asked on
Attachments to GroupWise
The following code will accept one attachment to a GroupWise message. Everything works great. The problem is that my boss would like to be able to send more than one attachment. I have tried various combinations and can't get it to recognize a second attachment. The Expert that helped me the first time is busy and suggested that i submit the question to the group. Anyone have a clue?
Private Sub Send_Click()
On Error GoTo Err_Send_Click
DoCmd.DoMenuItem acFormBar, acRecordsMenu, acSaveRecord, , acMenuVer70
Dim dbs As Database, rst As Recordset
Dim dbsf As Database, rstf As Recordset
'Second attachment
Dim dbsf_2 As Database, rstf_2 As Recordset
Dim objGroupWise As Object, objAccount As Object, objMailbox As Object
Dim objMessage As Object, objMessages As Object, objRecipients As Object
Dim objRecipient As Object, MessageSent As Variant
Dim objAttachments As Object, objFile As Object
'Second attachment
Dim objAttachments_2 As Object, objFile_2 As Object
Set dbs = CurrentDb()
Set rst = dbs.OpenRecordset("tbl_1")
rst.MoveFirst
Do Until rst.EOF
Set objGroupWise = CreateObject("NovellGroupW areSession ")
Set objAccount = objGroupWise.Login
Set objMailbox = objAccount.Mailbox
Set objMessages = objMailbox.Messages
Set objMessage = objMessages.Add("GW.MESSAG E.MAIL", "egwDraft")
Set objRecipients = objMessage.Recipients
Set objAttachments = objMessage.Attachments
Set objRecipient = objRecipients.Add(rst![e_m ail])
' Trap for no attachment
If IsNull(filename.Value) Then
Set dbsf = CurrentDb()
Set rstf = dbsf.OpenRecordset("tbl_me ssage")
Me.email = objRecipient
objMessage.Subject = Me.Title
objMessage.BodyText = Me.Message
objMessage.Send
MsgBox ("Message Sent!")
rst.MoveNext
Else
' Attach a file
Set dbsf = CurrentDb()
Set rstf = dbsf.OpenRecordset("tbl_me ssage")
Set objAttachments = objAttachments.Add(rstf![f ilename])
Me.email = objRecipient
objMessage.Subject = Me.Title
objMessage.BodyText = Me.Message
objMessage.Send
MsgBox ("Message Sent!")
rst.MoveNext
End If
Loop
Exit_Send_Click:
Exit Sub
Err_Send_Click:
MsgBox Err.Description
Resume Exit_Send_Click
End Sub
Private Sub Send_Click()
On Error GoTo Err_Send_Click
DoCmd.DoMenuItem acFormBar, acRecordsMenu, acSaveRecord, , acMenuVer70
Dim dbs As Database, rst As Recordset
Dim dbsf As Database, rstf As Recordset
'Second attachment
Dim dbsf_2 As Database, rstf_2 As Recordset
Dim objGroupWise As Object, objAccount As Object, objMailbox As Object
Dim objMessage As Object, objMessages As Object, objRecipients As Object
Dim objRecipient As Object, MessageSent As Variant
Dim objAttachments As Object, objFile As Object
'Second attachment
Dim objAttachments_2 As Object, objFile_2 As Object
Set dbs = CurrentDb()
Set rst = dbs.OpenRecordset("tbl_1")
rst.MoveFirst
Do Until rst.EOF
Set objGroupWise = CreateObject("NovellGroupW
Set objAccount = objGroupWise.Login
Set objMailbox = objAccount.Mailbox
Set objMessages = objMailbox.Messages
Set objMessage = objMessages.Add("GW.MESSAG
Set objRecipients = objMessage.Recipients
Set objAttachments = objMessage.Attachments
Set objRecipient = objRecipients.Add(rst![e_m
' Trap for no attachment
If IsNull(filename.Value) Then
Set dbsf = CurrentDb()
Set rstf = dbsf.OpenRecordset("tbl_me
Me.email = objRecipient
objMessage.Subject = Me.Title
objMessage.BodyText = Me.Message
objMessage.Send
MsgBox ("Message Sent!")
rst.MoveNext
Else
' Attach a file
Set dbsf = CurrentDb()
Set rstf = dbsf.OpenRecordset("tbl_me
Set objAttachments = objAttachments.Add(rstf![f
Me.email = objRecipient
objMessage.Subject = Me.Title
objMessage.BodyText = Me.Message
objMessage.Send
MsgBox ("Message Sent!")
rst.MoveNext
End If
Loop
Exit_Send_Click:
Exit Sub
Err_Send_Click:
MsgBox Err.Description
Resume Exit_Send_Click
End Sub
ASKER
If I follow the code right, this will create a message with a subject and a body. These are parts of the message I already have in place. I'm trying to add files as attachments and I can get one but not a second. Do you know enough Spanish to know where there might be code to do this? I wouldn't know where to begin.
Hi, you will need 2 Functions, the InitializeOutlook() to initialize the outlook Process for automation and CreateMail() that have "Optional astrAttachments As Variant" that are passed in this place.
:: For Each varAttach In astrAttachments
:: .Attachments.Add varAttach
:: Next varAttach
------------
Function InitializeOutlook() As Boolean
' This function is used to initialize the global Application and
' NameSpace variables.
On Error GoTo Init_Err
Set golApp = New Outlook.Application ' Application object.
Set gnspNameSpace = golApp.GetNamespace("MAPI" ) ' Namespace object.
InitializeOutlook = True
Init_End:
Exit Function
Init_Err:
InitializeOutlook = False
Resume Init_End
End Function
------------
------------
Function CreateMail(astrRecip As Variant, _
strSubject As String, _
strMessage As String, _
Optional astrAttachments As Variant) As Boolean
' This procedure illustrates how to create a new mail message
' and use the information passed as arguments to set message
' properties for the subject, text (Body property), attachments,
' and recipients.
Dim objNewMail As Outlook.MailItem
Dim varRecip As Variant
Dim varAttach As Variant
Dim blnResolveSuccess As Boolean
On Error GoTo CreateMail_Err
' Use the InitializeOutlook procedure to initialize global
' Application and NameSpace object variables, if necessary.
If golApp Is Nothing Then
If InitializeOutlook = False Then
MsgBox "Unable to initialize Outlook Application " _
& "or NameSpace object variables!"
Exit Function
End If
End If
Set golApp = New Outlook.Application
Set objNewMail = golApp.CreateItem(olMailIt em)
With objNewMail
For Each varRecip In astrRecip
.Recipients.Add varRecip
Next varRecip
blnResolveSuccess = .Recipients.ResolveAll
For Each varAttach In astrAttachments
.Attachments.Add varAttach
Next varAttach
.Subject = strSubject
.Body = strMessage
If blnResolveSuccess Then
.Send
Else
MsgBox "Unable to resolve all recipients. Please check " _
& "the names."
.Display
End If
End With
CreateMail = True
CreateMail_End:
Exit Function
CreateMail_Err:
CreateMail = False
Resume CreateMail_End
End Function
:: For Each varAttach In astrAttachments
:: .Attachments.Add varAttach
:: Next varAttach
------------
Function InitializeOutlook() As Boolean
' This function is used to initialize the global Application and
' NameSpace variables.
On Error GoTo Init_Err
Set golApp = New Outlook.Application ' Application object.
Set gnspNameSpace = golApp.GetNamespace("MAPI"
InitializeOutlook = True
Init_End:
Exit Function
Init_Err:
InitializeOutlook = False
Resume Init_End
End Function
------------
------------
Function CreateMail(astrRecip As Variant, _
strSubject As String, _
strMessage As String, _
Optional astrAttachments As Variant) As Boolean
' This procedure illustrates how to create a new mail message
' and use the information passed as arguments to set message
' properties for the subject, text (Body property), attachments,
' and recipients.
Dim objNewMail As Outlook.MailItem
Dim varRecip As Variant
Dim varAttach As Variant
Dim blnResolveSuccess As Boolean
On Error GoTo CreateMail_Err
' Use the InitializeOutlook procedure to initialize global
' Application and NameSpace object variables, if necessary.
If golApp Is Nothing Then
If InitializeOutlook = False Then
MsgBox "Unable to initialize Outlook Application " _
& "or NameSpace object variables!"
Exit Function
End If
End If
Set golApp = New Outlook.Application
Set objNewMail = golApp.CreateItem(olMailIt
With objNewMail
For Each varRecip In astrRecip
.Recipients.Add varRecip
Next varRecip
blnResolveSuccess = .Recipients.ResolveAll
For Each varAttach In astrAttachments
.Attachments.Add varAttach
Next varAttach
.Subject = strSubject
.Body = strMessage
If blnResolveSuccess Then
.Send
Else
MsgBox "Unable to resolve all recipients. Please check " _
& "the names."
.Display
End If
End With
CreateMail = True
CreateMail_End:
Exit Function
CreateMail_Err:
CreateMail = False
Resume CreateMail_End
End Function
ASKER
I'm trying to figure this out, but I feel a little slow. Is "astrAttachments" a table?
I did the following and it's worked without any problems
Sub NewGWMail()
On Error GoTo GWError
Dim GW As GroupwareTypeLibrary.Appli cation2
Dim GWAccount As GroupwareTypeLibrary.Accou nt2
Dim GWMailbox As GroupwareTypeLibrary.Folde r2
Dim GWMessage As GroupwareTypeLibrary.Messa ge
Dim GWMessages As GroupwareTypeLibrary.Messa ge2
Dim GWAttachments As GroupwareTypeLibrary.Attac hments
Dim GWattachment As GroupwareTypeLibrary.Attac hment
Dim strRecipient As String
Dim strStatusFile As String
Dim strRefrlFile As String
Dim strIFSP As String
Dim strIFSP_Support As String
Dim strChild As String
Dim strInput As String
Dim strText As String
Set GW = CreateObject("NovellGroupW areSession ") 'Opens GroupWise for process
Set GWAccount = GW.Login 'Pulls last login
Set GWMailbox = GWAccount.MailBox
Set GWMessage = GWMailbox.Messages.Add
strStatusFile = Me.txtHoldStatus.Value
strRefrlFile = Me.txtHoldReferral.Value
strIFSP = Me.txtHoldReferralIFSP.Val ue
strIFSP_Support = Me.txtHoldIFSP_Support.Val ue
strChild = Me.First_Name & " " & Me.Last_Name 'Establishes child's name.
strText = "Attached are 4 documents: " & vbCrLf & " Child Intake Profile" _
& vbCrLf & " Specialized Instruction Billing Form" _
& vbCrLf & " A Pre-Filled IFSP Form" _
& vbCrLf & " Pre-Filled IFSP Support Documents" _
& vbCrLf & "You may view them by clicking on the attachment - the documents will open in Word. " _
strRecipient = Me.txtFRCEMail 'pulls E-Mail address from Form
GWMessage.Subject = "Intake for " & strChild
strInput = InputBox("Add any message or special instructions for this E-Mail", "Input message for " & Me.txtFRCName)
GWMessage.BodyText = "Dear " & txtPickFRCFName & vbCrLf & strText & vbCrLf & strInput
GWMessage.Recipients.Add strRecipient, , egwTo 'FRC E Mail address from form
GWMessage.Recipients.Add "delliot@co.pierce.wa.us", , egwCC 'Copy of E Mail to me as back up
GWMessage.Recipients.Add "aelrod@co.pierce.wa.us", , egwCC 'Copy of E Mail to Athena as back up
GWMessage.Attachments.Add (strStatusFile) 'specific documents in FRC file are attached
GWMessage.Attachments.Add (strRefrlFile)
GWMessage.Attachments.Add (strIFSP)
GWMessage.Attachments.Add (strIFSP_Support)
GWMessage.Send
MsgBox "Mail Sent"
CloseGW:
Set GWMessage = Nothing
Set GWAccount = Nothing
Set GW = Nothing
Exit Sub
GWError:
MsgBox "Error" & Err.Description & Err.Source
Exit Sub
End Sub
Sub NewGWMail()
On Error GoTo GWError
Dim GW As GroupwareTypeLibrary.Appli
Dim GWAccount As GroupwareTypeLibrary.Accou
Dim GWMailbox As GroupwareTypeLibrary.Folde
Dim GWMessage As GroupwareTypeLibrary.Messa
Dim GWMessages As GroupwareTypeLibrary.Messa
Dim GWAttachments As GroupwareTypeLibrary.Attac
Dim GWattachment As GroupwareTypeLibrary.Attac
Dim strRecipient As String
Dim strStatusFile As String
Dim strRefrlFile As String
Dim strIFSP As String
Dim strIFSP_Support As String
Dim strChild As String
Dim strInput As String
Dim strText As String
Set GW = CreateObject("NovellGroupW
Set GWAccount = GW.Login 'Pulls last login
Set GWMailbox = GWAccount.MailBox
Set GWMessage = GWMailbox.Messages.Add
strStatusFile = Me.txtHoldStatus.Value
strRefrlFile = Me.txtHoldReferral.Value
strIFSP = Me.txtHoldReferralIFSP.Val
strIFSP_Support = Me.txtHoldIFSP_Support.Val
strChild = Me.First_Name & " " & Me.Last_Name 'Establishes child's name.
strText = "Attached are 4 documents: " & vbCrLf & " Child Intake Profile" _
& vbCrLf & " Specialized Instruction Billing Form" _
& vbCrLf & " A Pre-Filled IFSP Form" _
& vbCrLf & " Pre-Filled IFSP Support Documents" _
& vbCrLf & "You may view them by clicking on the attachment - the documents will open in Word. " _
strRecipient = Me.txtFRCEMail 'pulls E-Mail address from Form
GWMessage.Subject = "Intake for " & strChild
strInput = InputBox("Add any message or special instructions for this E-Mail", "Input message for " & Me.txtFRCName)
GWMessage.BodyText = "Dear " & txtPickFRCFName & vbCrLf & strText & vbCrLf & strInput
GWMessage.Recipients.Add strRecipient, , egwTo 'FRC E Mail address from form
GWMessage.Recipients.Add "delliot@co.pierce.wa.us",
GWMessage.Recipients.Add "aelrod@co.pierce.wa.us", , egwCC 'Copy of E Mail to Athena as back up
GWMessage.Attachments.Add (strStatusFile) 'specific documents in FRC file are attached
GWMessage.Attachments.Add (strRefrlFile)
GWMessage.Attachments.Add (strIFSP)
GWMessage.Attachments.Add (strIFSP_Support)
GWMessage.Send
MsgBox "Mail Sent"
CloseGW:
Set GWMessage = Nothing
Set GWAccount = Nothing
Set GW = Nothing
Exit Sub
GWError:
MsgBox "Error" & Err.Description & Err.Source
Exit Sub
End Sub
ASKER
Good morning,
Just got in and picked up your code. I'll give it a try. Thanks
Just got in and picked up your code. I'll give it a try. Thanks
ASKER
I've created a form with all the controls and looked throught the code and I like it. Problem is my system doesn't like one of the first lines:
GW As GroupwareTypeLibrary.Appli cation2
It says "User defined type not defined"
Am I running a different version for you? Or do I possibly need to load some library files?
GW As GroupwareTypeLibrary.Appli
It says "User defined type not defined"
Am I running a different version for you? Or do I possibly need to load some library files?
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
Thanks for the help. The key for me was to dim a variable rather that try to get the file directly from an address.
Everything works great! My boss will be very happy.
Patrick
Everything works great! My boss will be very happy.
Patrick
The Code in commented in English
http://www.jtl.co.pt/vba/outlook.htm