Hi All,
I have used a database template from this site and changed it to suit my needs but I have a bit of a problem with some of the code. I know how to update the worksheet with the relevant userform text fields and in another project I did I have successfully sent userform text fields in the body of an email.
For this project I want to update the worksheet AND send an email at the same time. However, using the two pieces of code together is causing an error that I can't seem to solve (using my very limited vba knowledge!). The code I am working on is below and I have highlighted the line that is getting the error message. Can anyone help with a solution?
Thanks in advance!
Code
Private Sub cmdSubmit_Click() 'Submit new record
Dim ws As Worksheet, lRow As Long, Str As String
Set ws = Sheets("Database") '<=== ERROR STARTS ON THIS LINE
lRow = ws.Range("B" & Rows.Count).End(xlUp).Offset(1).Row
'____error handling______
If txtAccNo.Value = "" Or Nullstring Then
MsgBox "Please enter an Account Number", vbCritical, "Error"
Me.txtAccNo.SetFocus
GoTo error1
End If
If txtAccName.Value = "" Or Nullstring Then
MsgBox "Please enter an Account Name", vbCritical, "Error"
Me.txtAccName.SetFocus
GoTo error1
End If
If txtPost.Value = "" Or Nullstring Then
MsgBox "Please enter a Post Code", vbCritical, "Error"
Me.txtPost.SetFocus
GoTo error1
End If
If txtCust.Value = "" Or Nullstring Then
MsgBox "Please enter a Customer Name", vbCritical, "Error"
Me.txtCust.SetFocus
GoTo error1
End If
If txtComp.Value = "" Or Nullstring Then
MsgBox "Please enter a Complaint Type", vbCritical, "Error"
Me.txtComp.SetFocus
GoTo error1
End If
If txtDetail.Value = "" Or Nullstring Then
MsgBox "Please enter the Complaint Details", vbCritical, "Error"
Me.txtDetail.SetFocus
GoTo error1
End If
'____error handling end______
If MsgBox("You are about to add this Record." & vbCr & "Do you wish to continue?", vbYesNo, _
"Confirm Add") = vbYes Then
ws.Cells(lRow, "A") = txtRef.Value
ws.Cells(lRow, "B") = CDate(txtDate.Value)
ws.Cells(lRow, "C") = txtOrig.Value
ws.Cells(lRow, "D") = txtAccNo.Value
ws.Cells(lRow, "E") = txtAccName.Value
ws.Cells(lRow, "F") = txtPost.Value
ws.Cells(lRow, "G") = txtCust.Value
ws.Cells(lRow, "H") = txtComp.Value
ws.Cells(lRow, "I") = txtDetail.Value
ws.Cells(lRow, "J") = txtAction.Value
Dim OutApp As Object
Dim OutMail As Object
Dim strBody As String
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
strBody = "Date Raised: " & frmComp.txtDate & vbNewLine & _
"Date Raised: " & frmComp.txtDate & vbNewLine & _
"Date Raised: " & frmComp.txtDate & vbNewLine & _
"Date Raised: " & frmComp.txtDate & vbNewLine & _
"Date Raised: " & frmComp.txtDate & vbNewLine & _
"Date Raised: " & frmComp.txtDate & vbNewLine & _
"Date Raised: " & frmComp.txtDate
On Error Resume Next
With OutMail
.To = "email address" '<= To Change
'.CC = "team leader & originator"
.Subject = "Subject"
.body = strBody
.Display
'.Send
.Display
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
End If
Unload Me
MsgBox ("Record Saved")
error1:
End Sub