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.
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