VBA Code Send Email Using Userform

mielkew · Mar 8, 2018

Hello Guys,

I have a VBA Code found in this website Kudos to the owner http://www.onlinepclearning.com/. I have modified it to my preference.

I introduced a new scenario where User can send request to Admin for Username and Password request using SendMail_Click() command button I created in the User Form. Now I need the form to close when request is sent.
Also, I want the cmdCheck_Click() to send an email whenever user successfully login in the user form.

I dont know how to integrate the Sendmail_Click() Code to cmdCheck_Click() without creating any problem.

I dont have much knowledge writing VBA code.

Any help is very much appreciated.

Thanks,
Mielkew

Option Explicit
Private Trial As Long
Private Sub cmdCheck_Click()
'Declare the variables
Dim AddData As Range, Current As Range
Dim user As Variant, Code As Variant
Dim PName As Variant, AName As Variant
Dim ws As Worksheet, ws2 As Worksheet, ws3 As Worksheet
Dim result As Integer
Dim TitleStr As String
Dim msg As VbMsgBoxResult

'Variables
user = Me.txtUser.Value
Code = Me.txtPass.Value
TitleStr = "Password check"
result = 0
Set Current = Sheet2.Range("U8")

'Error handler
On Error GoTo errHandler:
'Destination location for login storage
Set AddData = Sheet2.Cells(Rows.Count, 2).End(xlUp).Offset(1, 0)
'Check the login and passcode for the administrator
If user <> "" And Not IsNumeric(user) And Code <> "" And IsNumeric(Code) Then
For Each AName In Sheet2.Range("Z8:Z108")
'If AName = Code Then 'Use this for passcode text
If AName = CLng(Code) And AName.Offset(0, -1) = user Then ' Use this for passcode numbers only
MsgBox "Welcome Back: " & user & " " & Code
'record user login
AddData.Value = user
AddData.Offset(0, 1).Value = Now
'Add usernmae to the worksheet
Current.Value = user
'Change variable if the condition is meet
result = 1
'Unload the form
Sheet2.Visible = True
Sheet2.Select
Unload Me
'Show the navigation form
'frmNavigation.Show
Exit Sub
End If
Next AName
End If

'Check user login with loop
If user <> "" And Not IsNumeric(user) And Code <> "" And IsNumeric(Code) Then
For Each PName In Sheet2.Range("H8:H108")
'If PName = Code Then 'Use this for passcode text
If PName = CLng(Code) And PName.Offset(0, -1) = user Then ' Use this for passcode numbers only
MsgBox "Welcome Back: " & user & " " & Code
'record user login
AddData.Value = user
AddData.Offset(0, 1).Value = Now
'Add usernmae to the worksheet
Current.Value = user

'unhide worksheet for user
If PName.Offset(0, 1) <> "" Then
Set ws = Worksheets(PName.Offset(0, 1).Value)
ws.Visible = True
End If

'unhide worksheet for user
If PName.Offset(0, 2) <> "" Then
Set ws2 = Worksheets(PName.Offset(0, 2).Value)
ws2.Visible = True
End If

'unhide worksheet for user
If PName.Offset(0, 3) <> "" Then
Set ws3 = Worksheets(PName.Offset(0, 3).Value)
ws3.Visible = True
End If

'unhide worksheet for user
If PName.Offset(0, 4) <> "" Then
Set ws3 = Worksheets(PName.Offset(0, 4).Value)
ws3.Visible = True
End If

'unhide worksheet for user
If PName.Offset(0, 5) <> "" Then
Set ws3 = Worksheets(PName.Offset(0, 5).Value)
ws3.Visible = True
End If

'unhide worksheet for user
If PName.Offset(0, 6) <> "" Then
Set ws3 = Worksheets(PName.Offset(0, 6).Value)
ws3.Visible = True
End If

'unhide worksheet for user
If PName.Offset(0, 7) <> "" Then
Set ws3 = Worksheets(PName.Offset(0, 7).Value)
ws3.Visible = True
End If

'unhide worksheet for user
If PName.Offset(0, 8) <> "" Then
Set ws3 = Worksheets(PName.Offset(0, 8).Value)
ws3.Visible = True
End If

'unhide worksheet for user
If PName.Offset(0, 9) <> "" Then
Set ws3 = Worksheets(PName.Offset(0, 9).Value)
ws3.Visible = True
End If

'unhide worksheet for user
If PName.Offset(0, 10) <> "" Then
Set ws3 = Worksheets(PName.Offset(0, 10).Value)
ws3.Visible = True
End If

'unhide worksheet for user
If PName.Offset(0, 11) <> "" Then
Set ws3 = Worksheets(PName.Offset(0, 11).Value)
ws3.Visible = True
End If

'show sheet tab if hidden
ActiveWindow.DisplayWorkbookTabs = True

'Change variable if the condition is meet
result = 1
'Unload the form
Unload Me
'Show the navigation form
'frmNavigation.Show
Exit Sub
End If
Next PName
End If

'Check to see if an error occurred
If result = 0 Then
'Increment error variable
Trial = Trial + 1
'Less then 3 error message
If Trial < 3 Then msg = MsgBox("Wrong password, please try again", vbExclamation + vbOKOnly, TitleStr)
Me.txtUser.SetFocus
'Last chance and close the workbook
If Trial = 3 Then
msg = MsgBox("Wrong password, the form will close", vbCritical + vbOKOnly, TitleStr)
ActiveWorkbook.Close False
End If
End If
Exit Sub
'Error block
errHandler:
MsgBox "An Error has Occurred " & vbCrLf & "The error number is: " _
& Err.Number & vbCrLf & Err.Description & vbCrLf & _
"Please notify the administrator"
End Sub

Private Sub SendMail_Click()
Dim OutApp As Outlook.Application
Dim OutMail As Outlook.MailItem
Dim strbody As String

Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(olMailItem)

strbody = "Hi Admin," & vbNewLine & vbNewLine & _
"Please provide access to Master Register." & vbNewLine & _
"Username:" & vbNewLine & _
"Password:"

On Error Resume Next
With OutMail
.To = "edward@gmail.com"
.CC = ""
.BCC = ""
.Subject = "Master Register New User and Password Request"
.Body = strbody
.Send
End With
On Error GoTo 0
MsgBox "Your request has been sent and is awaiting approval from Admin"
Set OutMail = Nothing
Set OutApp = Nothing
End Sub

Private Sub UserForm_QueryClose _
(Cancel As Integer, CloseMode As Integer)
' Prevents use of the Close button
If CloseMode = vbFormControlMenu Then
MsgBox "Clicking the Close button does not work."
Cancel = True
End If
End Sub

ranman256 · Mar 8, 2018

after you send, close.

.Send
Unload Me

mielkew · Mar 10, 2018

Ranman256,

thank you very much.. look at that for that small piece of code

. I been searching google for hours. hehehe

.Send
MsgBox "Your request has been sent and is awaiting approval from Admin."
Unload Me
ActiveWorkbook.Close False

One more question though, how can I add in this code when the user has successfully login or when a login error attempts to send email notification to the admin.

Thanks,
Mielkew

ranman256 · Mar 12, 2018

not sure, usu the user manually logs into the email server before running the code.

mielkew · Mar 12, 2018

I tried adding this code and declaring it as variable but somehow email is not sending. Am I missing something?

I did add it after the user entered correct credential and even before having the MsgBox Welcome Back.

Dim OutApp As Outlook.Application
Dim OutMail As Outlook.MailItem

On Error GoTo errHandler:
'Destination location for login storage
Set AddData = Sheet2.Cells(Rows.Count, 2).End(xlUp).Offset(1, 0)
'Check the login and passcode for the administrator
If user <> "" And Not IsNumeric(user) And Code <> "" And IsNumeric(Code) Then
For Each AName In Sheet2.Range("Z8:Z108")
'If AName = Code Then 'Use this for passcode text
If AName = CLng(Code) And AName.Offset(0, -1) = user Then ' Use this for passcode numbers only

Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(olMailItem)

On Error Resume Next

With OutMail
.To = "edward@hbkcrccjv.com"
.CC = ""
.BCC = ""
.Subject = "Successful Access in Master Register"
.Body = "Hi Admin" & vbNewLine & _
"Successful Login Access" & vbNewLine
.Send

End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
MsgBox "Welcome Back: – " & user & " "

Exit Sub

VBA Code Send Email Using Userform

mielkew

New Member

Excel Facts

ranman256

Well-known Member

mielkew

New Member

ranman256

Well-known Member

mielkew

New Member

Similar threads

Forum statistics

Share this page

VBA Code Send Email Using Userform

mielkew

New Member

Excel Facts

ranman256

Well-known Member

mielkew

New Member

ranman256

Well-known Member

mielkew

New Member

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock