Hi guys,
I'm working on some coding where I can search for a customer order via a UserForm and then it will attach it to Outlook and get ready to send an email, I've managed to program it so that if text or NO number is entered it will prompt the user for a number. However, when I enter an incorrect order ID (like one that doesn't exist) it will attach ALL of the sheet (with all customer data on it).
I was wondering if it is possible to display an error and say "Enter a valid order number" if the order reference does not exist.
Any thoughts?
My code is below:
Option Explicit
Private Sub cmdExit_Click()
Unload Me
End Sub
Private Sub cmdLookup_Click()
Dim Row As Integer
If IsNumeric(txtOrderID.Text) = False Then
MsgBox "Please enter a valid number."
Else
Sheets("Macro").Select
Range("A1:P1").Select
Rows(ActiveCell.Row).Select
Selection.Copy
Sheets("Export").Select
Range("A1:P1").Select
Selection.PasteSpecial
Sheets("Macro").Select
Range("K1").Activate
Do
If ActiveCell.Value = "" Then Exit Do
ActiveCell.Offset(1, 0).Activate
If ActiveCell.Value = txtOrderID.Text Then
Row = ActiveCell.Row
Rows(ActiveCell.Row).Select
Selection.Copy
Sheets("Export").Select
Range("A2").Activate
ActiveCell.PasteSpecial
ActiveCell.Offset(1, 0).Activate
Sheets("Macro").Select
Range("K" & Row).Activate
ActiveCell.Offset(1, 0).Activate
Row = ActiveCell.Row
Rows(ActiveCell.Row).Select
Selection.Copy
Sheets("Export").Select
ActiveCell.PasteSpecial
Range("A2").Activate
txtMemberID.Text = ActiveCell.Value
ActiveCell.Offset(0, 1).Activate
txtFirstName.Text = ActiveCell.Value
ActiveCell.Offset(0, 1).Activate
txtSurname.Text = ActiveCell.Value
ActiveCell.Offset(0, 9).Activate
txtOrderDate.Text = ActiveCell.Value
End If
Loop
Dim email As String
Dim subj As String
Dim msg As String
Dim Send As Integer
email = Range("E2").Value
subj = "Music By Post Ltd Invoice"
msg = "Hello " & txtFirstName & "," & vbCrLf & vbCrLf
msg = msg & "Thank you for your recent order, please find attached the summary of your order." & vbCrLf & vbCrLf
msg = msg & "Thank for your custom" & vbCrLf & vbCrLf
msg = msg & "Music By Post Ltd."
Call sendEmail(email, subj, msg, 1)
End If
End Sub
Public Sub sendEmail(email As String, subj As String, msg As String, import As Integer)
Dim Outlook As Object
Dim MailItem As Object
Dim Export As Workbook
Dim Filename As String
Dim relativePath As String
Set Outlook = CreateObject("Outlook.Application")
Set MailItem = Outlook.createItem(0)
Application.ScreenUpdating = False
ActiveSheet.Copy
Set Export = ActiveWorkbook
Filename = "Invoice.xls"
On Error Resume Next
Kill "C:\" & Filename
On Error GoTo 0
relativePath = ThisWorkbook.Path & "\MusicByPostInvoice" & ActiveWorkbook.Name
ActiveWorkbook.SaveAs Filename:=relativePath
With MailItem
.to = email
.importance = import
.Subject = subj
.body = msg
.attachments.Add ActiveWorkbook.FullName
.Display
End With
Export.ChangeFileAccess Mode:=xlReadOnly
Kill Export.FullName
Export.Close SaveChanges:=False
Application.ScreenUpdating = True
Set Outlook = Nothing
Set MailItem = Nothing
Unload Me
End Sub
Private Sub TxtExit_Click()
End Sub
Private Sub UserForm_Initialize()
txtOrderID.SetFocus
End Sub
Bookmarks