Hi, When my code runs and it's a fail it sends the email and clears TextBox10 & 11 but I can not seem to get it to SetFocus back to TextBox10, can anyone help.
VBA Code:
Private Sub TextBox10_AfterUpdate()
TextBox10.Text = UCase(TextBox10.Text)
If TextBox1.Value = "" Or TextBox10.Value = "" Then Exit Sub
If TextBox1.Value = TextBox10.Value Then
TextBox11 = ("PASS")
TextBox10.BackColor = vbGreen
TextBox11.BackColor = vbGreen
Else
TextBox11 = ("FAIL")
TextBox10.BackColor = vbRed
TextBox11.BackColor = vbRed
Application.Speech.Speak "FAIL"
Dim sPath As String
result = MsgBox("THIS LABEL CODE DOES NOT MATCH THE PRICE SHEET", vbOKOnly + vbCritical, "WARNING")
If result = vbOK Then
Dim xOutApp As Object
Dim xOutMail As Object
Dim xMailBody As String
Dim wb As Workbook
On Error Resume Next
Set xOutApp = CreateObject("Outlook.Application")
Set xOutMail = xOutApp.CreateItem(0)
xMailBody = "WARNING" & vbNewLine & vbNewLine & _
"There has been a no match label scanning error" & vbNewLine & vbNewLine & _
"PRODUCT CODE: " & ComboBox1.Value & vbNewLine & _
"PRODUCT DESCRIPTION: " & TextBox2.Value & vbNewLine & _
"LABEL QTY SELETED: " & TextBox8.Value & vbNewLine & _
"LABEL CODE ON PRICE SHEET: " & TextBox1.Value & vbNewLine & _
"LABEL CODE SCANNED: " & TextBox10.Value
On Error Resume Next
With xOutMail
.To = "my.email.co.uk"
'.CC = "my.email.co.uk" & ";" " my.email.co.uk " & ";" & "my.email"
.Subject = "Stores label code scanning error"
.Body = xMailBody
.Attacments = ActiveSheet
.Send
End With
On Error GoTo 0
Set xOutMail = Nothing
Set xOutApp = Nothing
TextBox10.Text = ""
TextBox11.Text = ""
TextBox10.BackColor = &HFFFFFF
TextBox11.BackColor = &H80000002
TextBox10.SetFocus
End If
End If
End Sub