Employee Suggestion System|Send via Outlook and Save to Database Using Excel VBA|Full Tutorial
Through this system, suggestions sent by employees are collected and processed. Notes related to the project:
➡ Outlook is used for sending mail
➡ All sent suggestions are saved in the database. You can use different methods (current workbook, other workbook, MS Access, etc.) when creating a database
➡ The number of characters used is limited. Restriction can be done both with code and without code. To do this process without writing code, you need to set a limiting number of characters in the MaxLength section of the Textbox control
➡ The system checks whether the suggestion type is selected or not
➡ The system checks whether the suggestion is written or not
💡 Source Code
Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal ms&)
Private Sub UserForm_Activate()
Dim sug_arr(1 To 4) As String, txt As String, p As String, i As Byte
sug_arr(1) = " Developing and improving staff qualifications"
sug_arr(2) = " Implementation of changes in the salary and bonus system"
sug_arr(3) = " Increasing team building activities to increase labor productivity"
sug_arr(4) = " Security: elimination of loopholes in the system"
message.Text = "Dear Recipient !" + vbNewLine + vbNewLine
txt = "Hi " + Application.UserName & " !"
Label1.Caption = Empty
For i = 1 To Len(txt)
DoEvents
Label1.Caption = Label1.Caption + Mid(txt, i, 1)
Sleep 50
Next i
p = "C:\Users\User\Desktop\ProjectPics\"
For i = 1 To 4
ImageList1.ListImages.Add , sug_arr(i), LoadPicture(p + "Icon" + CStr(i) + ".jpg")
Next i
Set ImageCombo1.ImageList = ImageList1
For i = 1 To ImageList1.ListImages.Count
ImageCombo1.ComboItems.Add , , ImageList1.ListImages(i).Key, i
Next i
End Sub
Private Sub ImageCombo1_Change()
SendKeys "{RIGHT}"
End Sub
Private Sub message_Change()
If Len(message.Text) ▶ 500 Then
MsgBox "The number of characters in the suggestion cannot exceed the specified limit", vbCritical + vbOKOnly, ""
message.Text = Left(message.Text, 500)
End If
char_used.Caption = Len(message.Text)
char_remaining.Caption = 500 - Val(char_used.Caption)
End Sub
Private Sub CommandButton1_Click()
With Application
.ScreenUpdating = 0
.DisplayAlerts = 0
If ImageCombo1.SelectedItem Is Nothing Then
MsgBox "Suggestion type not selected", vbExclamation + vbOKOnly, ""
ElseIf message.Value = Empty Then
MsgBox "No suggestion found", vbExclamation + vbOKOnly, ""
Else:
Dim ws As Worksheet, r_index As Long, i As Long, temp_t As String
Dim oapp As New Outlook.Application, omail As Outlook.MailItem
Set omail = oapp.CreateItem(olMailItem)
With omail
.To = "[email protected]"
.CC = Empty
.BCC = Empty
.Subject = "Suggestion type: " + ImageCombo1.SelectedItem
For i = 1 To 3
temp_t = temp_t + vbNewLine
Next i
.Body = message.Text + temp_t + "Yours faithfully," & vbNewLine & Environ("username")
.Send
End With
Set oapp = Nothing
Set omail = Nothing
Set ws = Worksheets("DB")
r_index = ws.Cells.Item(Rows.Count, 1).End(XlDirection.xlUp).Offset(1).Row
ws.Cells(r_index, 1) = Environ("username")
ws.Cells(r_index, 2) = ImageCombo1.SelectedItem
ws.Cells(r_index, 3) = message.Value
ws.Cells(r_index, 4) = CInt(char_total.Caption)
ws.Cells(r_index, 5) = CInt(char_used.Caption)
MsgBox "Your suggestion has already been sent", vbInformation + vbOKOnly, ""
With message
.Text = Empty
.SetFocus
End With
ImageCombo1.Text = "Select"
.ScreenUpdating = -1
.DisplayAlerts = -1
End If
End With
End Sub
Private Sub CommandButton2_Click()
With message
If .Text ◀▶ "" Then
If MsgBox("Are you sure to delete the text ?", vbQuestion + vbYesNo, "") = vbNo Then Exit Sub
.Text = ""
MsgBox "Text deleted", vbInformation + vbOKOnly, ""
Else:
MsgBox "No text found to delete", vbInformation + vbOKOnly, ""
End If
.SetFocus
End With
End Sub
Private Sub CommandButton3_Click()
MsgBox "Use the Shift and Enter key combination for a new line", vbInformation + vbOKOnly, ""
End Sub
------------------------------------------------------------------------------------------
Buy a Cofee ☕ for theworldofalgorithms: https://ko-fi.com/theworldofalgorithms
🥰Thank you for the donation. I am deeply grateful for your help!🥰
------------------------------------------------------------------------------------------
#excel
#msexcel
#msexceltutorial
#msexcelcourse
#vba
#vbatutorial
#excelvba
#fulltutorial
#excelvbatutorial
#microsoftexceltutorial
#tutorial
#exceltutorial
#advancedexcel
#advancedexceltraining
#tutor
#exceltutor
#exceltutoring
#exceltutoringonline
#onlineexceltutoring
#algorithm
#algorithms
#programming
#program
#script
#vbamacro
#vbamacros
#usingmacro
#veryuseful
#useful
#veryusefulmacro
#freeeducation
#freeprogramming
#freelancer
#excelfreelancer
#vbafreelancer
#freelanceservices
#vbauserform
#excelvbauserform
#employeesuggestionsystem
#imagelist
#excelvbaimagelist
#vbaimagelist
#imagecombo
#excelvbaimagecombo
#vbaimagecombo
#label
#excelvbalabel
#vbalabel
#textbox
#textboxexcel
#excelvbatextbox
#vbatextbox
#vbaimagecombo
#commandbutton
#vbacommandbutton
#excelvbacommandbutton