Form Timer emails

[DMT Dave]

Hi Guy's here is one I was hoping to try and achieve, maybe possible maybe not, if someone can help please ?



1: I have a "Grab Email" button that copies the active email, I then need to click into a text box "txtMailMessage"

2: I then "double click" the text box to add parts of the data into relevant fields ie: email address/ name / product / contact details etc...….. then I add my reply via tick boxes then send the mail that is displayed the txtMailMessage

3: I then click save email (to a table)

4: Click "Clear All", I will not add this code as it is quite long (it just basically me.tbxName = False) and does this for all tick boxes

I will put the code 1 to 3 next but my target is, can the form timer grab the mail every from a particular inbox every 30 seconds, auto paste to "txtMailMessage" then another 30 seconds auto add to relevant fields (my double click) then try and save the mail (my click save mail) then if this email address exists, clear all and do not save ?

1: Grab mail

Dim WordApp As Word.Application
Dim wdDoc As Word.Document
Dim activeMailMessage As MailItem
Dim rs As DAO.Recordset

If TypeName(ActiveExplorer.Selection.Item(1)) = "MailItem" Then
    Set activeMailMessage = ActiveExplorer.Selection.Item(1)
    activeMailMessage.GetInspector().WordEditor.Range.FormattedText.Copy
   ' Me.txtMailMessage.SetFocus
    Me.tbxPaste = True

End If

2: Click into txtmailmessage

Dim cSearch As String, OrgMessage As String
cSearch = Me.txtClientSearch
OrgMessage = Me.txtMailMessage
If Me.tbxPaste = True Then
If Me.txtMailMessage = "" Then
DoCmd.RunCommand acCmdPaste
End If
End If
If Me.tbxPaste = True Then
If Left(Me.txtMailMessage, 5) = "REPLY" Then
Me.txtMailMessage = vbNewLine & vbNewLine & _
OrgMessage & vbNewLine & "............................................................................"
DoCmd.RunCommand acCmdPaste
End If
End If
Me.tbxPaste = False
If Me.tbxSendFormData = True Then
DoCmd.CancelEvent
Else
Me.txtCC.SetFocus
End If

3: Double click

Dim astrLines() As String, strBody As String, EmailAdd As String, LiftMake As String, StCu As String
Dim PCLine() As String, ContactNo() As String, ClientName() As String, SerialNo() As String, LiftType() As String, LModel() As String
Dim CLSearch() As String, LiftAge() As String
Dim L As Long, PC As Long, CN As Long, SN As Long, LB As Long, MD As Long, Tel As Long, Cont As Long, CL As Long, AOL As Long
Dim Mystr As String, fName As String, SName As String, cTitle As String
If Me.tbxPaste = False Then
If Me.txtMailMessage <> "" Then
strBody = Me.txtMailMessage
astrLines = Split(strBody, vbCrLf)
For L = 0 To UBound(astrLines)
If InStr(1, astrLines(L), "*Email Address:") > 0 Then
'MsgBox Mid(astrLines(L), 16)
Me.txtEmailTo = Mid(astrLines(L), 17)
End If
Next L
LiftAge = Split(strBody, vbCrLf)
For AOL = 0 To UBound(LiftAge)
If InStr(1, LiftAge(AOL), "Age Of Lift:") > 0 Then
Me.txtAgeOfLift = Mid(LiftAge(AOL), 14)
End If
Next AOL
CLSearch = Split(strBody, vbCrLf)
For CL = 0 To UBound(CLSearch)
If InStr(1, CLSearch(CL), "How did you hear about us?:") > 0 Then
Me.txtClientSearch = Mid(CLSearch(CL), 29)
End If
Next CL
ContactNo = Split(strBody, vbCrLf)
For Tel = 0 To UBound(ContactNo)
If InStr(1, ContactNo(Tel), "*Contact Number:") > 0 Then
Me.txtTel = Mid(ContactNo(Tel), 18)
End If
Next Tel
LModel = Split(strBody, vbCrLf)
For MD = 0 To UBound(LModel)
If InStr(1, LModel(MD), "Lift Type:") > 0 Then
StCu = Mid(LModel(MD), 12)
If Left(StCu, 3) = "str" Then
Me.tbxStraight = True
Me.tbxCurved = False
End If
If Left(StCu, 3) = "Cur" Then
Me.tbxStraight = False
Me.tbxCurved = True
End If
End If
Next MD
PCLine = Split(strBody, vbCrLf)
For PC = 0 To UBound(PCLine)
If InStr(1, PCLine(PC), "Post Code:") > 0 Then
'MsgBox Mid(PCLine(PC), 11)
Me.txtPostCode = Mid(PCLine(PC), 12)
End If
Next PC
ClientName = Split(strBody, vbCrLf)
For CN = 0 To UBound(ClientName)
If InStr(1, ClientName(CN), "*Name:") > 0 Then
Me.txtClientName = Mid(ClientName(CN), 8)
'End If
If Left(Me.txtClientName, 3) = "Mrs" Then
cTitle = Mid(ClientName(CN), 8, 3)
Me.cboClientTitle = cTitle
Me.txtClientName = Mid(txtClientName, 12)
End If
If Left(Me.txtClientName, 3) = "Miss" Then
cTitle = Mid(ClientName(CN), 8, 4)
Me.cboClientTitle = cTitle
Me.txtClientName = Mid(txtClientName, 13)
End If
If Left(Me.txtClientName, 3) = "Mr" Then
cTitle = Mid(ClientName(CN), 8, 3)
Me.cboClientTitle = cTitle
Me.txtClientName = Mid(txtClientName, 12)
End If
'If Left(Me.txtClientName, 4) = "Miss" Then
'cTitle = Left(Me.txtClientName, 4)
'Me.cboClientTitle = cTitle
'Me.txtClientName = Mid(Me.txtClientName, 6)
'End If
'If Left(Me.txtClientName, 2) = "Mr" Then
'cTitle = Left(Me.txtClientName, 2)
'Me.cboClientTitle = cTitle
'Me.txtClientName = Mid(Me.txtClientName, 4)
'End If
End If
Next CN
SerialNo = Split(strBody, vbCrLf)
For SN = 0 To UBound(SerialNo)
If InStr(1, SerialNo(SN), "Serial Number (if available):") > 0 Then
Me.txtSN = Mid(SerialNo(SN), 30)
Me.tbxGotSN = True
Else
Me.txtSN = ""
Me.tbxGotSN = False
End If
Next SN
LiftType = Split(strBody, vbCrLf)
For LB = 0 To UBound(LiftType)
If InStr(1, LiftType(LB), "Lift Brand:") > 0 Then
LiftMake = Mid(LiftType(LB), 13)
Me.txtBrand = LiftMake
End If
Next LB
End If
End If

4: Save mail

   Dim rs As DAO.Recordset, rs2 As DAO.Recordset, rst As DAO.Recordset
   Dim mStr As String, MyFOC As String, NameExist As String
   Dim mDate As Date
   
If Me.tbxStraight = True Then
mStr = "Straight"
End If
If Me.tbxCurved = True Then
mStr = "Curved"
End If
If Me.tbxFOC = True Then
MyFOC = "Yes"
End If
If Me.tbxFOC = False Then
MyFOC = "No"
End If
NameExist = Me.txtClientName
If Not IsNull(NameExist = DLookup("Client", "tblEmails", "[Client] = '" & NameExist & "'")) Then
Set rst = CurrentDb.OpenRecordset("Select * From tblEmails WHERE Client = '" & NameExist & "'")
With rst
Do Until rst.EOF
rst.MoveFirst
.Delete
rst.MoveNext
Loop
End With
Else
DoCmd.CancelEvent
End If
Set rs = CurrentDb.OpenRecordset("Select * From tblEmails")
With rs
.AddNew
!Client = Me.txtClientName
!PostCode = Me.txtPostCode
!Email = Me.txtEmailTo
!Message = Me.txtMailMessage
!LiftType = Me.txtBrand & " " & mStr
!Charge = Me.txtCharge
!FOC = MyFOC
!AgeOfLift = Me.txtAgeOfLift
!ClientSearch = Me.txtClientSearch
!Tel = Me.txtTel
!Offered = Me.txtPrice
'!OfferDate = ""
.Update
.Close
End With
Set rs = Nothing

[Minty]

You can't have two timer events on a form, but you could use the main timer to run code that had a suitable delay in it. e.g

Run part 1
Run part 2
wait 30 seconds (why the delay, and why 30 seconds ?)
Run Part 3
Run Part 4

I would probably extend the delay to a 2 minute cycle otherwise you may try and fire the event before the first set of events is finished.

I also wouldn't want to try and do anything else with this database while this was running. Timer events cause strange pauses / effects on other open forms.

[rpeare]

What is your goal here, to have an 'autosave' function so you don't have to click your 'save' button? If you're using bound forms it's already autosaving every time you alter a field. If you're using unbound controls that's a different matter. Also the way you're going about adding a record is extremely inefficient you'd be better off constructing an INSERT INTO SQL statement then executing it.