Solved My DB does not display email with .accde file (1 Viewer)

Pop_Access

Member
Local time
Yesterday, 16:41
Joined
Aug 19, 2019
Messages
35
I have an option in my DB to send an Email, and the project display the Email before I send it.
in the original file (.accdb), the function is works well, but when I save the project as ( .accde) the function does not work ( the project will not display the Email).

Thanks
 

arnelgp

..forever waiting... waiting for jellybean!
Local time
Today, 08:41
Joined
May 7, 2009
Messages
14,556
just tested it and convert the db to accde.
still it works and display the email in outlook.
 

Pop_Access

Member
Local time
Yesterday, 16:41
Joined
Aug 19, 2019
Messages
35
just tested it and convert the db to accde.
still it works and display the email in outlook.
i have tested the db many time, it working well, but when i convert it to .accde it will not work.
 

arnelgp

..forever waiting... waiting for jellybean!
Local time
Today, 08:41
Joined
May 7, 2009
Messages
14,556
can you show the function?
 

Pop_Access

Member
Local time
Yesterday, 16:41
Joined
Aug 19, 2019
Messages
35
can you show the function?

Function AutoEmail(MySQL As String)

Dim objOutlook As Outlook.Application
Dim objEmailItem As MailItem
Dim rs As DAO.Recordset
Dim rssent As DAO.Recordset
Dim Reccount As Long
Dim i As Integer
Dim SID As String


Set rs = CurrentDb.OpenRecordset(MySQL)

'count the Records

Reccount = DCount("[stuid]", "QAutoSendEmail")
Forms!frm_login!lblSendingEmail.Visible = True
'*************

' if the user dose't have Email, move next

If Reccount > 0 Then
rs.MoveFirst
Do Until rs.EOF

For i = i + 1 To Reccount
If IsNull(rs!Email) Then
i = i - 1
Reccount = Reccount - 1
rs.MoveNext

Else

If objOutlook Is Nothing Then
Set objOutlook = New Outlook.Application
End If

' Display lbl Sending Email process

Forms!frm_login!lblSendingEmail.Caption = ("Sending " & i & " Out of " & Reccount & " " & rs!Email)


Set objEmailItem = objOutlook.CreateItem(olMailItem)

With objEmailItem
.To = rs!Email
.Subject = rs!corsname & " Certificate Will be Expired after 30 Days"

.Body = "Dear/ " & rs!stuname
.Display

' To fill out the sentdate field

Set rssent = CurrentDb.OpenRecordset("SELECT tbl_AtndCors.stuID, tbl_AtndCors.SentDate, tbl_Session.corsID " & _
" FROM tbl_Session INNER JOIN tbl_AtndCors ON tbl_Session.SessionID = tbl_AtndCors.SessionID WHERE tbl_AtndCors.stuID = " & rs!stuID & " And " & _
" tbl_Session.corsID = " & rs!corsID)

rssent.Edit
rssent!SentDate = Date
rssent.Update

End With

Set rssent = Nothing
Set objEmailItem = Nothing
Set objOutlook = Nothing
rs.MoveNext

End If
Next i
Loop
Else

End If
rs.Close
rssent.Close

End Function
 

arnelgp

..forever waiting... waiting for jellybean!
Local time
Today, 08:41
Joined
May 7, 2009
Messages
14,556
try this one:
Code:
Dim objOutlook As Outlook.Application

Function AutoEmail(MySQL As String)


    Dim objEmailItem As MailItem
    Dim rs As DAO.Recordset
    Dim rssent As DAO.Recordset
    Dim Reccount As Long
    Dim i As Integer
    Dim SID As String
    
    Set objOutlook = New Outlook.Application
    
    Set rs = CurrentDb.OpenRecordset(MySQL)
    
    'count the Records
    
    Reccount = DCount("[stuid]", "QAutoSendEmail")
    Forms!frm_login!lblSendingEmail.Visible = True
    '*************
    
    ' if the user dose't have Email, move next
    
    If Reccount > 0 Then
        rs.MoveFirst
        Do Until rs.EOF
        
            For i = i + 1 To Reccount
                If IsNull(rs!Email) Then
                    i = i - 1
                    Reccount = Reccount - 1
                    rs.MoveNext
                
                Else
                
                    If objOutlook Is Nothing Then
                        Set objOutlook = New Outlook.Application
                    End If
                    
                    ' Display lbl Sending Email process
                    
                    Forms!frm_login!lblSendingEmail.Caption = ("Sending " & i & " Out of " & Reccount & " " & rs!Email)
                    
                    
                    Set objEmailItem = objOutlook.CreateItem(olMailItem)
                    
                    With objEmailItem
                        .To = rs!Email
                        .Subject = rs!corsname & " Certificate Will be Expired after 30 Days"
                        
                        .Body = "Dear/ " & rs!stuname
                        .Display
                        
                        ' To fill out the sentdate field
                        
                        Set rssent = CurrentDb.OpenRecordset("SELECT tbl_AtndCors.stuID, tbl_AtndCors.SentDate, tbl_Session.corsID " & _
                        " FROM tbl_Session INNER JOIN tbl_AtndCors ON tbl_Session.SessionID = tbl_AtndCors.SessionID WHERE tbl_AtndCors.stuID = " & rs!stuID & " And " & _
                        " tbl_Session.corsID = " & rs!corsID)
                        
                        rssent.Edit
                        rssent!SentDate = Date
                        rssent.Update
                    
                    End With
                    
                    Set rssent = Nothing
                    Set objEmailItem = Nothing
                    'Set objOutlook = Nothing
                    rs.MoveNext
                
                End If
            Next i
        Loop
    Else
    
    End If
    rs.Close
    rssent.Close

End Function
 

Pop_Access

Member
Local time
Yesterday, 16:41
Joined
Aug 19, 2019
Messages
35
try this one:
Code:
Dim objOutlook As Outlook.Application

Function AutoEmail(MySQL As String)


    Dim objEmailItem As MailItem
    Dim rs As DAO.Recordset
    Dim rssent As DAO.Recordset
    Dim Reccount As Long
    Dim i As Integer
    Dim SID As String
    
    Set objOutlook = New Outlook.Application
    
    Set rs = CurrentDb.OpenRecordset(MySQL)
    
    'count the Records
    
    Reccount = DCount("[stuid]", "QAutoSendEmail")
    Forms!frm_login!lblSendingEmail.Visible = True
    '*************
    
    ' if the user dose't have Email, move next
    
    If Reccount > 0 Then
        rs.MoveFirst
        Do Until rs.EOF
        
            For i = i + 1 To Reccount
                If IsNull(rs!Email) Then
                    i = i - 1
                    Reccount = Reccount - 1
                    rs.MoveNext
                
                Else
                
                    If objOutlook Is Nothing Then
                        Set objOutlook = New Outlook.Application
                    End If
                    
                    ' Display lbl Sending Email process
                    
                    Forms!frm_login!lblSendingEmail.Caption = ("Sending " & i & " Out of " & Reccount & " " & rs!Email)
                    
                    
                    Set objEmailItem = objOutlook.CreateItem(olMailItem)
                    
                    With objEmailItem
                        .To = rs!Email
                        .Subject = rs!corsname & " Certificate Will be Expired after 30 Days"
                        
                        .Body = "Dear/ " & rs!stuname
                        .Display
                        
                        ' To fill out the sentdate field
                        
                        Set rssent = CurrentDb.OpenRecordset("SELECT tbl_AtndCors.stuID, tbl_AtndCors.SentDate, tbl_Session.corsID " & _
                        " FROM tbl_Session INNER JOIN tbl_AtndCors ON tbl_Session.SessionID = tbl_AtndCors.SessionID WHERE tbl_AtndCors.stuID = " & rs!stuID & " And " & _
                        " tbl_Session.corsID = " & rs!corsID)
                        
                        rssent.Edit
                        rssent!SentDate = Date
                        rssent.Update
                    
                    End With
                    
                    Set rssent = Nothing
                    Set objEmailItem = Nothing
                    'Set objOutlook = Nothing
                    rs.MoveNext
                
                End If
            Next i
        Loop
    Else
    
    End If
    rs.Close
    rssent.Close

End Function

Thank you, it's working fine.
 

Users who are viewing this thread

Top Bottom