Doug F. said:
What is the best way to email a zipped file from VBA? I see comment re
Outlook security hooks, is emailing a myfile.zip going to be a problem?
Thank you.
Doug,
Here's a function I have creaed to send emails via Outlook. There is a
security issue. If the user has the latest security pataches for Outlook,
then they will have to respond to one or more confirmation dialogs from
Access.
The only other way I know to send email via VBA is using CDONTS; however, I
beleive that requires that each client be running IIS with SMTP enabled --
probably not something you can count on.
Here's the function:
-------------------------------
Public Function fSendEmail( _
strFrom As String, _
varRecipients() As Variant, _
strSubject As String, _
strHTMLBody As String, _
Optional strAttachmentPath As String = "", _
Optional intAction As Integer = 0) As Boolean
On Error GoTo HandleError
'Performs the specified email action using Outlook. Actions are to display
the
'email (1), save the email (2), or send the email (0). Recipients are passed
'via a variant array or two columns. The first contians the recipient address
'and the second column contains the recipient type. If no type is specified,
'a type of olTo is used.
Dim i As Integer
Dim fs As Object
fSendEmail = False
Set fs = CreateObject("Scripting.FileSystemObject")
Dim olApp As Outlook.Application
Dim olMail As Object 'Have to late bind as appointments e.t.c screw it up
Dim olRecipient As Object
Set olApp = CreateObject("Outlook.Application")
Set olMail = olApp.CreateItem(olMailItem)
With olMail
For i = 0 To UBound(varRecipients())
If Len(varRecipients(i, 0)) > 0 Then
Set olRecipient = .Recipients.Add(varRecipients(i, 0))
olRecipient.Type = _
IIf(Len(varRecipients(i, 1)) > 0, varRecipients(i, 1),
olTo)
End If
Next i
.Subject = strSubject
.HTMLBody = strHTMLBody
If fs.FileExists(strAttachmentPath) Then .Attachments.Add
strAttachmentPath
Select Case intAction
Case 0
.Send
Case 1
.Display
Case 2
.Save
End Select
End With
fSendEmail = True
Finalize:
Set fs = Nothing
Set olMail = Nothing
Set olApp = Nothing
Exit Function
HandleError:
fSendEmail = False
Resume Finalize
End Function
-----------------------
