Access 2002 Email Form Record

[jfussell]

I have this idea to email specific records to a default email address, but I'm very new at this concept of using access to email records, so I will try and describe inasmuch detail as I can about my form to be emailed.

I have a form called Investors and I use one tab to track basic Investor info, another tab to insert comments utilizing a subForm with the autodate function date() for the date comment was created, and the user would enter comments and a follow up date (can be left blank). I would like to set up the capability that when this follow up date occurs, say April 2nd 2004, Access would automatically email all the basic Investor info, as well as the comment and autodate associated with the follow up date record.

Is this possible to create? As I mentioned before, I'm very new at this concept, and just intermediate at best in access, so any help/guidance on this subject would be greatly appreciated. Thanks.

 

[JoyInOK]

I have a tickler system set up in my database. When a user opens the database, the following code is executed in the designated start-up form. This routine sends an email to the person (from himself/herself) referencing the particular claim (record). The code uses the following fields which are in the same table as the record we're working on:
TicklerDate - date - Date to send reminder
TicklerReason - memo - Reason to check the record
TicklerPerson - text - person to send reminder to
TicklerSent - yes/no - checked when the code issues the reminder.

Note that you'll need to set a reference to DAO and to your vversion of Outlook before using the code

Private Sub Form_Load()
'call the routine to check for ticklers that are due
CheckForTicklers
End Sub

Private Sub CheckForTicklers()
'checks to see if the given user is due for a reminder about a particular claim
On Error Goto ErrorHandler
'create a recordset of all unsent ticklers this user has set
Dim rstCurrent As Recordset
Dim strSQL As String
Dim strUserName As String
'get the user name
Dim sUser As String
Dim lpBuff As String * 1024
'Get the longin User Name
GetUserName lpBuff, Len(lpBuff)
sUser = Left$(lpBuff, (InStr(1, lpBuff, vbNullChar)) - 1)
lpBuff = ""
strUserName = sUser

strSQL = "SELECT CLM_FORM.[VC LM], CLM_FORM.VICTIM, CLM_FORM.TicklerDate, CLM_FORM.TicklerReason, CLM_FORM.TicklerPerson, CLM_FORM.TicklerSent FROM CLM_FORM WHERE (((CLM_FORM.TicklerDate)<=Date()) AND ((CLM_FORM.TicklerPerson)='" & strUserName & "') AND ((CLM_FORM.TicklerSent)=No));"
Set rstCurrent = CurrentDb.OpenRecordset(strSQL)
If rstCurrent.RecordCount = 0 Then 'there are no ticklers pending
'release the vaiable
Set rstCurrent = Nothing
Exit Sub
End If
' otherwise move to the last record to get an accurate record count
rstCurrent.MoveLast
rstCurrent.MoveFirst
Dim strSubject As String
Dim strBody As String

'loop through the recordset
Dim j As Integer
For j = 1 To rstCurrent.RecordCount
strSubject = "Reminder on Claim " & rstCurrent.Fields("VC LM") & " " & rstCurrent.Fields("VICTIM")
strBody = "You set a tickler to remind you about this claim for the following reason: " & rstCurrent.Fields("TicklerReason")

Call SendMessage(sUser, strSubject, strBody)
'set the TicklerSent field to yes so this reminder will not be sent again
rstCurrent.Edit
rstCurrent.Fields("TicklerSent") = vbYes
rstCurrent.Update
rstCurrent.MoveNext
Next j
'release the variable
Set rstCurrent = Nothing
ErrorHandler:
msgbox "Error #" & err.number & " occurred. " & err.description, vbokonly, "Error"
exit sub
End Sub

Private Sub SendMessage(Recipname As String, SubjectText As String, BodyText As String, Optional AttachmentPath As String)
Dim objOutlook As Outlook.Application
Dim objOutlookMsg As Outlook.MailItem
Dim objOutlookRecip As Outlook.Recipient
Dim objOutlookAttach As Outlook.Attachment

'Create the Outlook session.
Set objOutlook = CreateObject("Outlook.Application")

' Create the message.
Set objOutlookMsg = objOutlook.CreateItem(olMailItem)

With objOutlookMsg
'Add the To recipient(s) to the message.
Set objOutlookRecip = .Recipients.Add(Recipname)
objOutlookRecip.TYPE = olTo

' Add the CC recipient(s) to the message.
'Set objOutlookRecip = .Recipients.Add("Andrew Fuller")
'objOutlookRecip.TYPE = olCC

' Set the Subject, Body, and Importance of the message.
.Subject = SubjectText

.Body = BodyText & vbCrLf
'.Importance = olImportanceHigh 'High importance

' Add attachments to the message.
If Not IsMissing(AttachmentPath) And AttachmentPath <> vbNullString Then
Set objOutlookAttach = .Attachments.Add(AttachmentPath)
End If

' Resolve each Recipient's name.
For Each objOutlookRecip In .Recipients
objOutlookRecip.Resolve
If Not objOutlookRecip.Resolve Then
objOutlookMsg.Display
End If
Next
'Show the email so it can be edited
.Display
End With
Set objOutlookMsg = Nothing
Set objOutlook = Nothing
End Sub

 

[DomFino]

Hi everyone,
I tried applying the code in this post to an application I am developing to track Grants and Projects funded by those Grants.

When I compile the code, I receive an error (see line in blue below) that states:

Compile Error
Sub or Function not defined.

Any help will be greatly appreciated.
Dom

'TicklerDate - date - Date to send reminder
'TicklerReason - memo - Reason to check the record
'TicklerPerson - text - person to send reminder to
'TicklerSent - yes/no - checked when the code issues the reminder.

'Note that you'll need to set a reference to DAO and to  your version of Outlook
'before using the code

Private Sub Form_Load()
'call the routine to check for ticklers that are due
  CheckForTicklers
End Sub

Private Sub CheckForTicklers()
'checks to see if the given user is due for a reminder about a particular grant
On Error GoTo ErrorHandler

'create a recordset of all unsent ticklers this user has set
Dim rstCurrent As Recordset
Dim strSQL As String
Dim strUserName As String
'***********************************************************

'get the user name
Dim sUser As String
    Dim lpBuff As String * 1024
    'Get the longin User Name
    [b][COLOR=blue]GetUserName lpBuff, Len(lpBuff)[/color][/b]
    sUser = Left$(lpBuff, (InStr(1, lpBuff, vbNullChar)) - 1)
    lpBuff = ""
strUserName = sUser

'***********************************************************

strSQL = "SELECT tblGrants.MasterID, tblGrants.GrantID, tblGrants.TicklerDate, tblGrants.TicklerReason, tblGrants.TicklerPerson, tblGrants.TicklerSent FROM tblGrants WHERE (((tblGrants.TicklerDate)<=Date()) AND ((tblGrants.TicklerPerson)='" & strUserName & "') AND ((tblGrants.TicklerSent)=No));"
Set rstCurrent = CurrentDb.OpenRecordset(strSQL)
If rstCurrent.RecordCount = 0 Then 'there are no ticklers pending
   'release the vaiable
    Set rstCurrent = Nothing
    Exit Sub
End If
' otherwise move to the last record to get an accurate record count
rstCurrent.MoveLast
rstCurrent.MoveFirst
Dim strSubject As String
Dim strBody As String

'loop through the recordset
  Dim j As Integer
  For j = 1 To rstCurrent.RecordCount
  strSubject = "Reminder on Grant " & rstCurrent.Fields("MasterID") & " " & rstCurrent.Fields("GrantID")
    strBody = "You set a tickler to remind you about this Grant for the following reason: " & rstCurrent.Fields("TicklerReason")
    
    Call SendMessage(sUser, strSubject, strBody)
    'set the TicklerSent field to yes so this reminder will not be sent again
    rstCurrent.Edit
    rstCurrent.Fields("TicklerSent") = vbYes
    rstCurrent.Update
    rstCurrent.MoveNext
  Next j
'release the variable
Set rstCurrent = Nothing
ErrorHandler:
MsgBox "Error #" & Err.Number & " occurred. " & Err.Description, vbOKOnly, "Error"
Exit Sub
End Sub

Private Sub SendMessage(Recipname As String, SubjectText As String, BodyText As String, Optional AttachmentPath As String)
   Dim objOutlook As Outlook.Application
   Dim objOutlookMsg As Outlook.MailItem
   Dim objOutlookRecip As Outlook.Recipient
   Dim objOutlookAttach As Outlook.Attachment

   'Create the Outlook session.
   Set objOutlook = CreateObject("Outlook.Application")

   ' Create the message.
   Set objOutlookMsg = objOutlook.CreateItem(olMailItem)

   With objOutlookMsg
       'Add the To recipient(s) to the message.
     Set objOutlookRecip = .Recipients.Add(Recipname)
      objOutlookRecip.Type = olTo

      ' Add the CC recipient(s) to the message.
      Set objOutlookRecip = .Recipients.Add("Nicole Waddell")
      objOutlookRecip.Type = olCC

      ' Set the Subject, Body, and Importance of the message.
      .Subject = SubjectText
      
      .Body = BodyText & vbCrLf
      .Importance = olImportanceHigh  'High importance

      ' Add attachments to the message.
'      If Not IsMissing(AttachmentPath) And AttachmentPath <> vbNullString Then
'       Set objOutlookAttach = .Attachments.Add(AttachmentPath)
'      End If

      ' Resolve each Recipient's name.
      For Each objOutlookRecip In .Recipients
         objOutlookRecip.Resolve
        If Not objOutlookRecip.Resolve Then
         objOutlookMsg.Display
      End If
      Next
      'Show the email so it can be edited
      .Display
  End With
   Set objOutlookMsg = Nothing
   Set objOutlook = Nothing
End Sub

 

[DomFino]

Woops!
I forgot to tell you all that I am running Access 2000
Dom

 

[PHV]

If not on win9x, you may try this:
'get the login user name
strUserName = Environ("USERNAME")

Hope This Helps, PH.
Want to get great answers to your Tek-Tips questions? Have a look at FAQ219-2884 or FAQ222-2244

 

[DomFino]

PHV
Thanks you for your reply. I did as you suggested and it now works. (I am using Windows 2K).
Thanks
Dom

OLD Code

'get the user name
Dim sUser As String
    Dim lpBuff As String * 1024
    'Get the longin User Name
'    GetUserName lpBuff, Len(lpBuff)
    sUser = Left$(lpBuff, (InStr(1, lpBuff, vbNullChar)) - 1)
    lpBuff = ""
'strUserName = sUser

New Code

'get the user name
Dim sUser As String
    'get the login user name
    strUserName = Environ("USERNAME")
sUser = strUserName