Automatische email reminder vanuit Ms access 2010

Status
Niet open voor verdere reacties.
B

Bajram01

Gebruiker
Lid geworden
11 jun 2016
Berichten
11
Hallo,
Ik wil dat de e-mails automatisch verzonden worden vanuit mijn MS access database. Ik gebruik MS access 2010 en Outlook 2010. Ik heb een module gemaakt AutoEmail en wordt opgeroepen via Private Sub Form_Timer() van navigatieformulier. Wanneer ik mijn navigatieformulier open de timer loopt maar geen e-mails worden verzonden. Ook geen foutcodes of iets dergelijks. Heeft dat iets te maken met de beveiliging van Outlook??

Module
Code: 
Function GenerateEmail(MySQL As String)
On Error GoTo Exit_Function:
Dim oOutlook As Outlook.Application
Dim oEmail As MailItem
Dim MyEmpName As String
Dim rs As Recordset
Set rs = CurrentDb.OpenRecordset(MySQL)
If rs.RecordCount > 0 Then
    rs.MoveFirst
    Do Until rs.EOF
    If IsNull(rs!Email) Then
            rs.MoveNext
    Else
        If oOutlook Is Noting Then
        Set oOutlook = New Outlook.Application
        End If
        Set oEmailItem = oOutlook.CreateItem(oIMailItem)
        With oEmailItem
                    MyEmpName = DLookup("EmpName", "tbl_Employee", "[EmpId] = " & rs!EmpName)
                    .To = rs!Email
                    .Subject = "Task doe in 30 days Reminder for " & MyEmpName
                    .Body = "Task Id: " & rs!TaskId & vbCr & _
                            "Task Name: " & rs!TaskName & vbCr & _
                            "Employee : " & MyEmpName & vbCr & _
                            "Task Due : " & rs!DueDate & vbCr & vbCr & _
                            "This email is auto genarated from Task Database, Please Do Not Reply!"
                    '.Display
                    .Sent
                    rs.Edit
                    rs!dateemailsent = Date
                    rs.Update
        End With
       Set oEmailItem = Nothing
        Set oOutlook = Nothing
        rs.MoveNext
    End If
    Loop
Else
    'Do Nothing
End If
rs.Close
Exit_Function:
End Function

Calling module
Code: 
Private Sub Form_Timer()
Me.TextTime.Value = Format(Time, "HH:mm:ss AM/PM")
Static iCount As Integer
    iCount = iCount + 1
        If iCount = 60 Then
            Me.TimerInterval = 0
            Call GenerateEmail("SELECT * FROM qryDuein30Days")
        If Me.TimerInterval - 125 Then
        End If
            Exit Sub
        End If
End Sub
 
Dat zal dit zijn:
If oOutlook Is Noting Then

Daar gaat het op fout en omdat je een On Error gebruikt die niks controleert zie je dat niet.

Er is dus een woordje fout geschreven. Noting moet zijn Nothing.
Het is typisch een situatie waarom ik zelf altijd Option Explicit aan heb staan en ook nooit een On Error zonder enige controle gebruik.

En de volgende:
doe = due
genarated = generated

Maar dat is alleen tekstueel en gaat het niet op fout.
 
Laatst bewerkt:
Dankjewel edmoor voor een snelle reactie.
Ik heb de fouten gecorrigeerd. De e-mails worden nog steeds niet verzonden.
 
Laatst bewerkt:
Complete berichten quooten is niet de beste manier om antwoord te geven. Die knop dus alleen gebruiken als je een quoot nodig hebt.
Om bij je vraag te blijven: volgens mij kan het een heel stuk simpeler. Al kun je deze aanpak uiteraard wel werkend krijgen. Maar waarom de Timer gebruikt?
 
Beste OctaFish,
Als het simpeler kan graag jouw voorstel/ suggestie. De timer hoeft niet.
 
Naast typfouten in de tekst, wat hooguit vervelend is voor je ontvangers als die goed zijn in taal, zitten er ook foute commando's in je code. Niet alleen Noting, maar ook Sent. Noting fout typen zou je gelijk moeten zien, want het is een intern commando en dat moet dus, bij correcte spelling, blauw worden en niet zwart blijven. Let daar op. 'Sent' is natuurlijk 'Send', maar daar zie je de kleur niet van omdat dat commando uit Outlook komt, en niet uit Access. Al zou je de juiste syntax natuurlijk met <F2> kunnen controleren.
Verder snap ik deze regel totaal niet:
Code: 
     MyEmpName = DLookup("EmpName", "tbl_Employee", "[EmpId] = " & rs!EmpName)
Waarom haal je een naam op die al in de Recordset zit? Tenzij de ene EmpName de andere niet is, in welk geval je eens serieus moet nadenken over de namen in je queries/tabellen. Hoe dan ook: de naam zou ik gewoon in de query meenemen, dan heb je de DLookup niet nodig.
Verder open en sluit je elke keer Outlook; nergens voor nodig. één keer openen volstaat; daarna maak je dan in de lus een nieuwe mail aan. En rs.MoveFirst in een recordset is overbodig; net als dat een voetreis altijd met de eerste stap begint, doet een recordset dat ook. Nooit zal een recordset met het tweede record beginnen, dus waarom als eerste proberen achteruit te lopen?
En de laatste: waarom je query niet filteren op niet-lege emailadressen? Die wil je tenslotte niet eens hebben, want die sla je nu ook over. Zet ze dan ook niet in de query.
Die timer is dus hopeloos; laat de mailing uitvoeren bij het openen van het formulier, dan is het gelijk klaar.
E.e.a. verwerkt ziet er dan zo uit:

Code: 
Private Sub Form_Load()
    GenerateEmail
End Sub

Code: 
Function GenerateEmail()
Dim oOutlook As Outlook.Application
Dim oEmail As Outlook.MailItem
Dim rs As DAO.Recordset
    
    On Error GoTo Exit_Function:
    Set rs = CurrentDb.OpenRecordset(("SELECT * FROM qryDuein30Days WHERE [Email] <> """""))
    Set oOutlook = New Outlook.Application
    If rs.RecordCount > 0 Then
        Do Until rs.EOF
            Set oEmailItem = oOutlook.CreateItem(oIMailItem)
            With oEmailItem
                .To = rs!Email
                .Subject = "Task due in 30 days... Reminder for " & rs!EmpName
                .Body = "Task Id: " & rs!TaskId & vbCr & _
                        "Task Name: " & rs!TaskName & vbCr & _
                        "Employee : " & MyEmpName & vbCr & _
                        "Task Due : " & rs!DueDate & vbCr & vbCr & _
                        "This email is auto generated from Task Database, Please Do Not Reply!"
                .Send
                rs.Edit
                rs!dateemailsent = Date
                rs.Update
            End With
            rs.MoveNext
        Loop
    End If
    rs.Close

Exit_Function:
End Function

Iedereen doet het, dus je bent in goed gezelschap, maar objecten op Nothing zetten na afloop is onzin; elke functie sluit de objecten al uit zichzelf af. Kun je dus weglaten.
 
Beste OctaFish,
Dankjewel voor de tips
De aangepaste code werkt alleen als outlook is afgesloten.
Ik krijg dan wel een waarschuwingen van MS Outlook: een programma dat toegang zoekt tot e-mailadresgegevens of dat namens mij e-mailberichten verzendt. Ik moet telkens klikken op Toestaan.
Kan ik deze beveiligingswaarschuwingen van Microsoft Office Outlook met een VBA code voorkomen, zodat deze melding niet meer verschijnt. Binnen mijn bedrijf heb ik geen machtiging om het in Outlook zelf aan te passen.
 
Die toestemming komt door een beveiligings issue van Outlook. Met een simpel gratis programmaatje is dat te omzeilen: ClickYes. Als jullie dat installeren wordt het klikken op de knoppen a.h.w. door ClickYes overgenomen, en loopt je code dus gewoon door. Verder kun je het mailen in Outlook afvangen door een andere mailroutine te gebruiken. Maar dan moet je dus in Outlook een procedure toevoegen.
 
Hier alvast de functie die je kunt gebruiken om vanuit de db te mailen zonder de beveiliging. De code plak je in Outlook in de module <ThisOutlookSession> en roep je aan vanuit je database.
Code: 
Public Function FnSendMailSafe(strTo As String, strCC As String, strBCC As String, strSubject As String, _
    strMessageBody As String, Optional strAttachments As String) As Boolean

' 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, 'test@test.com; test2@test.com' is
' acceptable for sending to multiple recipients.
'
' (c) 2005 Wayne Phillips - Written 07/05/2005
' Last updated 26/03/2008 - Bugfix for empty varRecipient strings
' http://www.everythingaccess.com

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
 
Ik heb de functie hier vandaan gehaald; daar staat ook meer uitleg.
 
Status
Niet open voor verdere reacties.
                    Steun ons                    

Nieuwste berichten

Terug
Bovenaan Onderaan