Za one koje nervira cekanje od 5 sekundi i Outlookov Security koji se (opravdano) buni jer neko/nesto
pokusava kroz Outlook da posalje email. Probajte sledece resenje. Naravno pod uslovom da smete da
menjate Security podesavanja.
Napomena: postojece resenje koristim za slanje Excel fajlova koje kreiram iz Accessa, saljuci odgovarajuce
podatke u Excel template. Zatim taj Excel fajl negde sacuvam i onda iz samog Accessa naredim da se posalje
kao prilog uz Email.
1. U Outlooku Tools/Macro/Security podesiti na Low
2. Pozvati VBA editor - Alt+F11
3. Sa desne strane dupli klik u project explorer prozoru na ThisOutlookSession
4. Paste koda u Outlook VBA
5. Jedan mali restart Outlooka i to je to
Code:
Option Explicit
' Code: Send E-mail without Security Warnings
' OUTLOOK 2003 VBA CODE FOR 'ThisOutlookSession' MODULE
' (c) 2005 Wayne Phillips (http://www.everythingaccess.com)
' Written 07/05/2005
' Last updated v1.4 - 26/03/2008
'
' Please read the full tutorial here:
' http://www.everythingaccess.co...-mail-without-Security-Warning
'
' Please leave the copyright notices in place - Thank you.
Private Sub Application_Startup()
'IGNORE - This forces the VBA project to open and be accessible using automation
' at any point after startup
End Sub
' FnSendMailSafe
' --------------
' Simply sends an e-mail using Outlook/Simple MAPI.
' Calling this function by Automation will prevent the warnings
' 'A program is trying to send a mesage on your behalf...'
' Also features optional HTML message body and attachments by file path.
'
' The To/CC/BCC/Attachments function parameters can contain multiple items by seperating
' them by a semicolon. (e.g. for the strTo parameter, '
[email protected];
[email protected]' is
' acceptable for sending to multiple recipients.
'
Public Function FnSendMailSafe(strTo As String, _
strCC As String, _
strBCC As String, _
strSubject As String, _
strMessageBody As String, _
Optional strAttachments As String) As Boolean
' (c) 2005 Wayne Phillips - Written 07/05/2005
' Last updated 26/03/2008 - Bugfix for empty recipient strings
' http://www.everythingaccess.com
'
' You are free to use this code within your application(s)
' as long as the copyright notice and this message remains intact.
On Error GoTo ErrorHandler:
Dim MAPISession As Outlook.NameSpace
Dim MAPIFolder As Outlook.MAPIFolder
Dim MAPIMailItem As Outlook.MailItem
Dim oRecipient As Outlook.Recipient
Dim TempArray() As String
Dim varArrayItem As Variant
Dim strEmailAddress As String
Dim strAttachmentPath As String
Dim blnSuccessful As Boolean
'Get the MAPI NameSpace object
Set MAPISession = Application.Session
If Not MAPISession Is Nothing Then
'Logon to the MAPI session
MAPISession.Logon , , True, False
'Create a pointer to the Outbox folder
Set MAPIFolder = MAPISession.GetDefaultFolder(olFolderOutbox)
If Not MAPIFolder Is Nothing Then
'Create a new mail item in the "Outbox" folder
Set MAPIMailItem = MAPIFolder.Items.Add(olMailItem)
If Not MAPIMailItem Is Nothing Then
With MAPIMailItem
'Create the recipients TO
TempArray = Split(strTo, ";")
For Each varArrayItem In TempArray
strEmailAddress = Trim(varArrayItem)
If Len(strEmailAddress) > 0 Then
Set oRecipient = .Recipients.Add(strEmailAddress)
oRecipient.Type = olTo
Set oRecipient = Nothing
End If
Next varArrayItem
'Create the recipients CC
TempArray = Split(strCC, ";")
For Each varArrayItem In TempArray
strEmailAddress = Trim(varArrayItem)
If Len(strEmailAddress) > 0 Then
Set oRecipient = .Recipients.Add(strEmailAddress)
oRecipient.Type = olCC
Set oRecipient = Nothing
End If
Next varArrayItem
'Create the recipients BCC
TempArray = Split(strBCC, ";")
For Each varArrayItem In TempArray
strEmailAddress = Trim(varArrayItem)
If Len(strEmailAddress) > 0 Then
Set oRecipient = .Recipients.Add(strEmailAddress)
oRecipient.Type = olBCC
Set oRecipient = Nothing
End If
Next varArrayItem
'Set the message SUBJECT
.Subject = strSubject
'Set the message BODY (HTML or plain text)
If StrComp(Left(strMessageBody, 6), "<HTML>", vbTextCompare) = 0 Then
.HTMLBody = strMessageBody
Else
.Body = strMessageBody
End If
'Add any specified attachments
TempArray = Split(strAttachments, ";")
For Each varArrayItem In TempArray
strAttachmentPath = Trim(varArrayItem)
If Len(strAttachmentPath) > 0 Then
.Attachments.Add strAttachmentPath
End If
Next varArrayItem
.Send 'No return value since the message will remain in the outbox if it fails to send
Set MAPIMailItem = Nothing
End With
End If
Set MAPIFolder = Nothing
End If
MAPISession.Logoff
End If
'If we got to here, then we shall assume everything went ok.
blnSuccessful = True
ExitRoutine:
Set MAPISession = Nothing
FnSendMailSafe = blnSuccessful
Exit Function
ErrorHandler:
MsgBox "An error has occured in the user defined Outlook VBA function FnSendMailSafe()" & vbCrLf & vbCrLf & _
"Error Number: " & CStr(Err.Number) & vbCrLf & _
"Error Description: " & Err.Description, vbApplicationModal + vbCritical
Resume ExitRoutine
End Function
6. Kod koji ubacujem u Access je sledeci
Code:
Option Explicit
' ACCESS VBA MODULE: Send E-mail without Security Warning
' (c) 2005 Wayne Phillips (http://www.everythingaccess.com)
' Written 07/05/2005
' Last updated v1.3 - 11/11/2005
'
' Please read the full tutorial & code here:
' http://www.everythingaccess.co...-mail-without-Security-Warning
'
' Please leave the copyright notices in place - Thank you.
'This is a test function - replace the e-mail addresses with your own before executing!!
'(CC/BCC can be blank strings, attachments string is optional)
Sub FnTestSafeSendEmail(strEmailTo As String, strSubject As String, strBody As String, strAttachment As String, Optional strEmailCC, Optional strEmailBCC As String)
Dim blnSuccessful As Boolean
Dim strHTML As String
' strHTML = "<html>" & _
' "<body>" & _
' "My <b><i>HTML</i></b> message text!" & _
' "</body>" & _
' "</html>"
' blnSuccessful = FnSafeSendEmail("
[email protected]", _
' "My Message Subject", _
' strHTML)
blnSuccessful = FnSafeSendEmail(strEmailTo, strSubject, strBody, strAttachment, _
IIf(strEmailCC <> "", strEmailCC, ""), IIf(strEmailBCC <> "", strEmailBCC, ""))
'A more complex example...
'blnSuccessful = FnSafeSendEmail("
[email protected];
[email protected]", _
"My Message Subject", _
strHTML, _
"C:\MyAttachmentFile1.txt; C:\MyAttachmentFile2.txt", _
"
[email protected]", _
"
[email protected]")
If blnSuccessful Then
' msgbox "E-mail message sent successfully!"
Else
MsgBox "Failed to send e-mail to " & strEmailTo
End If
End Sub
'This is the procedure that calls the exposed Outlook VBA function...
Public Function FnSafeSendEmail(strTo As String, _
strSubject As String, _
strMessageBody As String, _
Optional strAttachmentPaths As String, _
Optional strCC As String, _
Optional strBCC As String) As Boolean
Dim objOutlook As Object ' Note: Must be late-binding.
Dim objNameSpace As Object
Dim objExplorer As Object
Dim blnSuccessful As Boolean
Dim blnNewInstance As Boolean
'Is an instance of Outlook already open that we can bind to?
On Error Resume Next
Set objOutlook = GetObject(, "Outlook.Application")
On Error GoTo 0
If objOutlook Is Nothing Then
'Outlook isn't already running - create a new instance...
Set objOutlook = CreateObject("Outlook.Application")
blnNewInstance = True
'We need to instantiate the Visual Basic environment... (messy)
Set objNameSpace = objOutlook.GetNamespace("MAPI")
Set objExplorer = objOutlook.Explorers.Add(objNameSpace.Folders(1), 0)
objExplorer.CommandBars.FindControl(, 1695).Execute
objExplorer.Close
Set objNameSpace = Nothing
Set objExplorer = Nothing
End If
blnSuccessful = objOutlook.FnSendMailSafe(strTo, strCC, strBCC, _
strSubject, strMessageBody, _
strAttachmentPaths)
If blnNewInstance = True Then objOutlook.Quit
Set objOutlook = Nothing
FnSafeSendEmail = blnSuccessful
End Function
7. Samo pozivanje slanja excel atachovanog fajla emailom iz Accessa je npr. komadnom:
Code:
Call FnTestSafeSendEmail(txtEmail, emailSubject, _
emailBody, Application.CurrentProject.Path & "\blablabla.xls", "", "")
Pretpostavljam (nije mi do sada trebalo) da bi se ovo lako "preradilo" da funkcionise i direktno iz Excela,
uzmite samo kao napomenu da ovo sluzi za slanje prikacenog fajla i da cete verovatno morati prvo da
sacuvate Excel fajl negde na disku.
Pozdrav