Using Gmail as Opposed to Outlook (1 Viewer)

SlimSquirrel

New member
Local time
Today, 09:39
Joined
Aug 4, 2015
Messages
6
View attachment Screen Shots.zip Hi,
I have sourced two different functions off the internet that both work fine individually. I have tried to put them together and cannot seem to get it to work. There are no errors so I have nothing to go on. I have very little knowledge of VBA so I am hoping that the mistake on my part is really obvious to one of you guys in the know. Any help or guidance would be appreciated.
I have attached screen shots of the original bits of code.
I have included below my attempt to combine them.
Code:
Option Compare Database
 Function GenerateEmail(MySQL As String)
On Error GoTo Exit_Function:
Dim oOutlook As Outlook.Application
Dim oEmailItem As Object
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 Nothing Then
        Set oOutlook = New Outlook.Application
        End If
        Set oEmailItem = CreateObject("CDO.message")
        With oEmailItem.Configuration.Fields
 .Item("h t t p ://schemas.microsoft.com/cdo/configuration/sendusing") = 2 'NTLM method
 .Item("h t t p ://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.gmail.com"
 .Item("h t t p ://schemas.microsoft.com/cdo/configuration/smptserverport") = 587
 .Item("h t t p ://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
 .Item("h t t p ://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
 .Item("h t t p ://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 60
 .Item("h t t p ://schemas.microsoft.com/cdo/configuration/sendusername") = usernameemail
 .Item("h t t p ://schemas.microsoft.com/cdo/configuration/sendpassword") = Password
 .Update
 End With
 With oEmailItem
                    MyEmpName = DLookup("empname", "tbl_employee", "[empid] = " & rs!EmpName)
                    .To = rs!Email
                    .From = usernameemail
                    .Subject = "Task due 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 generated from Task Database. Please Do Not Reply!"
                    .Send
                    rs.Edit
                    rs!DateEmailSent = Date
                    rs.Update
        End With
        Set oEmailItem = Nothing
        rs.MoveNext
    End If
    Loop
Else
    ' do notthing
End If
'Close record set
rs.Close
Exit_Function:
    Exit Function
End Function
 

SlimSquirrel

New member
Local time
Today, 09:39
Joined
Aug 4, 2015
Messages
6
I have also included spaces between http: to break the links to allow me to post ;)
 

Users who are viewing this thread

Top Bottom