J
John Strung
I have a script that, when you press a button in Accees, starts Outlook
(if it is not running), opens a new message, and puts data from various
fields in the Access database into the To:, Subject: and body of the
e-mail message and then inserts the Outlook sig file.
Much of this is done by SendKeys (yes, I know the shortcomings of
Sendkey, but haven't been able to figure out how else to do this). This
works fine with our older computers, but our new work stations seem to
be too fast for the script and things get a bit scrambled.
Is there any VBA instructions tht I can put between the lines of script
to insert, say, a .1 second pause between each set of SendKeys
instructions near the end of the script?
In the alternative, can anyone suggest how to eliminate the necessity to
use SendKeys. The script is below:
-----------
Private Sub email_button_Click()
Dim varx As String, lawinits As String
Dim usnm As String, criteria As String, MyDB As Database
Dim MySet As DAO.Recordset, emaccess As String, nomatch As Variant
Dim Msg As String, x As Long
On Error GoTo emailerrorhandler
DoCmd.GoToControl "FindBox"
If IsNull([E-Mail]) Then Exit Sub 'EXIT IF NO E-MAIL ADDRESS
usnm = Environ("username")
Set MyDB = CurrentDb()
Set MySet = MyDB.OpenRecordset("xref")
criteria = "usnames = '" & usnm & "'"
MySet.FindFirst criteria 'finds the first instance of the
username in the xref table
If nomatch Then
Msg = "Problem - speak to John Strung"
Exit Sub
End If
lawinits = MySet![inits]
emaccess = MySet![internetaccess]
DoCmd.Close A_TABLE, "XREF"
If emaccess = "no" Then Exit Sub
x = AppActivateClass("rctrl_renwnd32")
If x = 0 Then
varx = InputBox("Enter MS Mail Password", "MS Mail Password")
If Len(CStr(varx)) < 3 Then Exit Sub
x = Shell("C:\Program Files\Microsoft Office\Office10\OUTLOOK.EXE", 1)
SendKeys varx & "{enter}", True
End If
SendKeys "^{f10}", True 'zoom window"
Dim olApp As Object
Dim objNewMail As Object
Dim objONewmail As Object
Dim AddressString As String, SubjectString As String
Dim bodystring1 As String, bodystring2 As String, bodystring3 As String
Set olApp = New Outlook.Application
Set objONewmail = olApp.CreateItem(olMailItem)
Set objNewMail = CreateObject("REDEMPTION.SafeMailItem")
objNewMail.Item = objONewmail
With objNewMail
AddressString = CStr(Me!)
SubjectString = CStr([File Name])
bodystring1 = "Our File Number: " & CStr([File Number]) & Chr(10)
bodystring2 = ""
bodystring3 = ""
If IsNull(Me![Claimno]) = 0 Then bodystring2 = "Your Claim Number: "
& CStr(Me![Claimno]) & Chr(10)
If IsNull(Me![DateLoss]) = 0 Then bodystring3 = "Date of Loss: " &
CStr(Me![DateLoss]) & Chr(10)
bodystring1 = bodystring1 & bodystring2 & bodystring3 &
"-------------------------" & Chr(10) & Chr(10)
..Recipients.Add AddressString
..Subject = SubjectString
..Body = bodystring1
..Display
SendKeys "{tab}", True
SendKeys "{pgdn}", True
SendKeys "%i", False
SendKeys "s", False
SendKeys "{enter}", True
SendKeys "{pgup}", True
If IsNull(Me![Claimno]) = 0 Then SendKeys "{down}", True
If IsNull(Me![DateLoss]) = 0 Then SendKeys "{down}", True
SendKeys "{down}", True
SendKeys "{down}", True
End With
Exit Sub
emailerrorhandler:
On Error GoTo 0
MsgBox "Open the In Box in MS Outlook and try again"
Exit Sub
End Sub
(if it is not running), opens a new message, and puts data from various
fields in the Access database into the To:, Subject: and body of the
e-mail message and then inserts the Outlook sig file.
Much of this is done by SendKeys (yes, I know the shortcomings of
Sendkey, but haven't been able to figure out how else to do this). This
works fine with our older computers, but our new work stations seem to
be too fast for the script and things get a bit scrambled.
Is there any VBA instructions tht I can put between the lines of script
to insert, say, a .1 second pause between each set of SendKeys
instructions near the end of the script?
In the alternative, can anyone suggest how to eliminate the necessity to
use SendKeys. The script is below:
-----------
Private Sub email_button_Click()
Dim varx As String, lawinits As String
Dim usnm As String, criteria As String, MyDB As Database
Dim MySet As DAO.Recordset, emaccess As String, nomatch As Variant
Dim Msg As String, x As Long
On Error GoTo emailerrorhandler
DoCmd.GoToControl "FindBox"
If IsNull([E-Mail]) Then Exit Sub 'EXIT IF NO E-MAIL ADDRESS
usnm = Environ("username")
Set MyDB = CurrentDb()
Set MySet = MyDB.OpenRecordset("xref")
criteria = "usnames = '" & usnm & "'"
MySet.FindFirst criteria 'finds the first instance of the
username in the xref table
If nomatch Then
Msg = "Problem - speak to John Strung"
Exit Sub
End If
lawinits = MySet![inits]
emaccess = MySet![internetaccess]
DoCmd.Close A_TABLE, "XREF"
If emaccess = "no" Then Exit Sub
x = AppActivateClass("rctrl_renwnd32")
If x = 0 Then
varx = InputBox("Enter MS Mail Password", "MS Mail Password")
If Len(CStr(varx)) < 3 Then Exit Sub
x = Shell("C:\Program Files\Microsoft Office\Office10\OUTLOOK.EXE", 1)
SendKeys varx & "{enter}", True
End If
SendKeys "^{f10}", True 'zoom window"
Dim olApp As Object
Dim objNewMail As Object
Dim objONewmail As Object
Dim AddressString As String, SubjectString As String
Dim bodystring1 As String, bodystring2 As String, bodystring3 As String
Set olApp = New Outlook.Application
Set objONewmail = olApp.CreateItem(olMailItem)
Set objNewMail = CreateObject("REDEMPTION.SafeMailItem")
objNewMail.Item = objONewmail
With objNewMail
AddressString = CStr(Me!)
SubjectString = CStr([File Name])
bodystring1 = "Our File Number: " & CStr([File Number]) & Chr(10)
bodystring2 = ""
bodystring3 = ""
If IsNull(Me![Claimno]) = 0 Then bodystring2 = "Your Claim Number: "
& CStr(Me![Claimno]) & Chr(10)
If IsNull(Me![DateLoss]) = 0 Then bodystring3 = "Date of Loss: " &
CStr(Me![DateLoss]) & Chr(10)
bodystring1 = bodystring1 & bodystring2 & bodystring3 &
"-------------------------" & Chr(10) & Chr(10)
..Recipients.Add AddressString
..Subject = SubjectString
..Body = bodystring1
..Display
SendKeys "{tab}", True
SendKeys "{pgdn}", True
SendKeys "%i", False
SendKeys "s", False
SendKeys "{enter}", True
SendKeys "{pgup}", True
If IsNull(Me![Claimno]) = 0 Then SendKeys "{down}", True
If IsNull(Me![DateLoss]) = 0 Then SendKeys "{down}", True
SendKeys "{down}", True
SendKeys "{down}", True
End With
Exit Sub
emailerrorhandler:
On Error GoTo 0
MsgBox "Open the In Box in MS Outlook and try again"
Exit Sub
End Sub