Dim User_Count As Long
Dim DeptData As Range
Dim CCI As Long
Dim CEM As Long
Dim MAN As Long
Dim OTH As Long
Dim PUR As Long
Dim MAR As Long
Dim TAM As Long
Dim WAR As Long
Private Sub cbCCI_Click()
Dim U As Long
If Me.cbCCI.Value = True Then
Me.DEPT_GROUPS.Value = 0
For U = 0 To lbUsers.ListCount - 1
lbUsers.Selected(U) = cbCCI
Next U
End If
End Sub
Private Sub cbCEM_Click()
Dim U As Long
If Me.cbCEM.Value = True Then
Me.DEPT_GROUPS.Value = 1
For U = 0 To lbUsers.ListCount - 1
lbUsers.Selected(U) = cbCEM
Next U
End If
End Sub
Private Sub cbMAN_Click()
Dim U As Long
If Me.cbMAN.Value = True Then
Me.DEPT_GROUPS.Value = 2
For U = 0 To lbUsers.ListCount - 1
lbUsers.Selected(U) = cbMAN
Next U
End If
End Sub
Private Sub cbOTH_Click()
Dim U As Long
If Me.cbOTH.Value = True Then
Me.DEPT_GROUPS.Value = 3
For U = 0 To lbUsers.ListCount - 1
lbUsers.Selected(U) = cbOTH
Next U
End If
End Sub
Private Sub cbPUR_Click()
Dim U As Long
If Me.cbPUR.Value = True Then
Me.DEPT_GROUPS.Value = 4
For U = 0 To lbUsers.ListCount - 1
lbUsers.Selected(U) = cbPUR
Next U
End If
End Sub
Private Sub cbMAR_Click()
Dim U As Long
If Me.cbMAR.Value = True Then
Me.DEPT_GROUPS.Value = 5
For U = 0 To lbUsers.ListCount - 1
lbUsers.Selected(U) = cbMAR
Next U
End If
End Sub
Private Sub cbTAM_Click()
Dim U As Long
If Me.cbTAM.Value = True Then
Me.DEPT_GROUPS.Value = 6
For U = 0 To lbUsers.ListCount - 1
lbUsers.Selected(U) = cbTAM
Next U
End If
End Sub
Private Sub cbWAR_Click()
Dim U As Long
If Me.cbWAR.Value = True Then
Me.DEPT_GROUPS.Value = 7
For U = 0 To lbUsers.ListCount - 1
lbUsers.Selected(U) = cbWAR
Next U
End If
End Sub
Private Sub DEPT_GROUPS_Change()
If Me.DEPT_GROUPS.Value = 0 Then
With Me.lbUsers
.RowSource = ""
Set DeptData = Sheet1.Range("CCI_MDI")
.List = DeptData.Cells.Value
For CCI = .ListCount - 1 To 0 Step -1
If .List(CCI, 1) = "" Then
.RemoveItem CCI
End If
Next CCI
End With
End If
If Me.DEPT_GROUPS.Value = 1 Then
With Me.lbUsers
.RowSource = ""
Set DeptData = Sheet1.Range("CE_MARKETING")
.List = DeptData.Cells.Value
For CEM = .ListCount - 1 To 0 Step -1
If .List(CEM, 1) = "" Then
.RemoveItem CEM
End If
Next CEM
End With
End If
If Me.DEPT_GROUPS.Value = 2 Then
With Me.lbUsers
.RowSource = ""
Set DeptData = Sheet1.Range("MANAGEMENT")
.List = DeptData.Cells.Value
For MAN = .ListCount - 1 To 0 Step -1
If .List(MAN, 1) = "" Then
.RemoveItem MAN
End If
Next MAN
End With
End If
If Me.DEPT_GROUPS.Value = 3 Then
With Me.lbUsers
.RowSource = ""
Set DeptData = Sheet1.Range("OTHER")
.List = DeptData.Cells.Value
For OTH = .ListCount - 1 To 0 Step -1
If .List(OTH, 1) = "" Then
.RemoveItem OTH
End If
Next OTH
End With
End If
If Me.DEPT_GROUPS.Value = 4 Then
With Me.lbUsers
.RowSource = ""
Set DeptData = Sheet1.Range("PURCHASING")
.List = DeptData.Cells.Value
For PUR = .ListCount - 1 To 0 Step -1
If .List(PUR, 1) = "" Then
.RemoveItem PUR
End If
Next PUR
End With
End If
If Me.DEPT_GROUPS.Value = 5 Then
With Me.lbUsers
.RowSource = ""
Set DeptData = Sheet1.Range("SALES_MAR")
.List = DeptData.Cells.Value
For MAR = .ListCount - 1 To 0 Step -1
If .List(MAR, 1) = "" Then
.RemoveItem MAR
End If
Next MAR
End With
End If
If Me.DEPT_GROUPS.Value = 6 Then
With Me.lbUsers
.RowSource = ""
Set DeptData = Sheet1.Range("SALES_TAM")
.List = DeptData.Cells.Value
For TAM = .ListCount - 1 To 0 Step -1
If .List(TAM, 1) = "" Then
.RemoveItem TAM
End If
Next TAM
End With
End If
If Me.DEPT_GROUPS.Value = 7 Then
With Me.lbUsers
.RowSource = ""
Set DeptData = Sheet1.Range("WAREHOUSE")
.List = DeptData.Cells.Value
For WAR = .ListCount - 1 To 0 Step -1
If .List(WAR, 1) = "" Then
.RemoveItem WAR
End If
Next WAR
End With
End If
End Sub
Private Sub cmdSend_Click()
Dim User_Name As String
Dim User_Pass As String
Dim User_Mail As String
Dim Mail_Subject As String
Dim Mail_Body As String
Dim U As Integer
'If Me.lbUsers.ListCount = 0 Then
' MsgBox "No email recipients have been selected from the user list.", vbOKOnly + vbExclamation, "INVALID ENTRY"
' Exit Sub
'End If
If Me.txtSubject.text = "" Then
MsgBox "Please include an email subject heading.", vbOKOnly + vbExclamation, "INVALID ENTRY"
Exit Sub
End If
If MsgBox("Send email notifications to selected users?", vbOKCancel, "CONFIRM EMAIL") = vbCancel Then
Exit Sub
End If
For U = 0 To Me.lbUsers.ListCount - 1
If Me.lbUsers.Selected(U) Then
User_Name = Me.lbUsers.List(U, 0)
User_Pass = Me.lbUsers.List(U, 1)
User_Mail = Me.lbUsers.List(U, 2)
Mail_Subject = Me.txtSubject.text
Mail_Body = "Hello " & User_Name & "," & Sheet1.Range("G1") & "<strong>" & User_Pass & "</strong>" & _
"<p>" & Me.txtBody.text & "<p>" & Sheet1.Range("G2")
Call SendEmail(User_Mail, Mail_Subject, Mail_Body)
End If
Next U
Unload Me
End Sub
Sub SendEmail(User_Mail As String, Mail_Subject As String, Mail_Body As String)
Dim olApp As Outlook.Application
Set olApp = CreateObject("Outlook.Application")
Dim olMail As Outlook.MailItem
Set olMail = olApp.CreateItem(olMailItem)
olMail.To = User_Mail
olMail.Subject = Mail_Subject
olMail.BodyFormat = olFormatHTML
olMail.HTMLBody = Mail_Body
olMail.Send
End Sub
Private Sub cmdCancel_Click()
Unload Me
End Sub
Network and collaborate with thousands of CTOs, CISOs, and IT Pros rooting for you and your success.
”The time we save is the biggest benefit of E-E to our team. What could take multiple guys 2 hours or more each to find is accessed in around 15 minutes on Experts Exchange.
Our community of experts have been thoroughly vetted for their expertise and industry experience.
The Distinguished Expert awards are presented to the top veteran and rookie experts to earn the most points in the top 50 topics.