VBA Cases with Listbox - Can you use Multi-Select?

Post number 4 has been selected as the best answer.

Status
Not open for further replies.
O

owensnw

New Member
Outlook version
Outlook 2019 64-bit
Email Account
Office 365 Exchange
I currently have a VBA scrip that is running in Outlook where it pops up a listbox. The user selects the attachment, then it is added to the current email and unloads the user form. Now we are wondering if we can do multi-select and choose multiple attachments to go to the email. Here is the listbox:

1605125839237.png


Code:
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)

If CloseMode = 0 Then Cancel = True

End Sub
Private Sub CommandButton2_Click()
End
End Sub

Private Sub CommandButton1_Click()
lstNo = ListBox1.ListIndex
Unload Me
End Sub

Private Sub ListBox1_Change()

End Sub

Private Sub UserForm_Initialize()
With ListBox1
.AddItem "-----------Credit------------"
.AddItem "OPE W9"
.AddItem "OPE Credit References"
.AddItem "OPE Credit Application"
.AddItem "----------Brochures----------"
.AddItem "Vogelsang Municipal Brochure"
.AddItem "Vogelsang Wine Brochure"
.AddItem "Vogelsang XR Buyers Guide"
.AddItem "Barnes Sithe Brochure"
.AddItem "Barnes SH Brochure"
.AddItem "Barnes Razor Brochure"
.AddItem "Barnes Pressure Sewer Brochure"
.AddItem "Barnes Upgrade Core Brochure"
.AddItem "Barnes Blade Brochure"
.AddItem "Barnes FRP Engineered Basins Brochure"
.AddItem "Mencarelli Wine Pump Brochure"
.AddItem "WasteCorp Municipal Brochure"
.AddItem "WasteCorp Industrial Brochure"
.AddItem "WasteCorp Double-Disc Brochure"
.AddItem "WasteCorp Self-Priming Brochure"
.AddItem "WasteCorp Pre-Packaged Lift Station Brochure"
.AddItem "BioGill Tower Plus Datasheet"
.AddItem "BioGill Ultra Datasheet"
.AddItem "BioGill Brewery Overview"
.AddItem "BioGill Food/Bev Overview"
.AddItem "ARO FDA / Food Compliant Pumps"
.AddItem "ARO 1.5 Inch Diaphragm Pump Cart Flyer"
.AddItem "ARO 2.5 Inch Diaphragm Pump Cart Flyer"
.AddItem "ARO Metalic Diaphragm Pump Brochure"
.AddItem "ARO Non-Metalic Diaphragm Pump Brochure"
.AddItem "Cloacina Product Card"
.AddItem "Cloacina Wine Introduction & Advantages"
.AddItem "Cloacina Wine Brochure"
.AddItem "Cloacina Mempac Mini Package"
.AddItem "Cloacina CEMPAC Thickener Brochure"
.AddItem "OpenChannelFlow Parshall Flume Brochure"
.AddItem "OpenChannelFlow Single Piece Shelters Brochure"
.AddItem "OpenChannelFlow Grinder Manhole Brochure"
.AddItem "AK Industries SS 1.25 & 2 Inch Rail Systems"
.AddItem "AK Industries SS 1.25 - 6 Inch Rail Systems"
.AddItem "AK Industries FRP Basins & Accessories"
.AddItem "Prime Solution RFP Family Brochure"
.AddItem "Prime Solution Simple Dewatering Solutions"
.AddItem "Prime Solution RFP Brochure"
.AddItem "Prime Solution RFP2.0 Brochure"
.AddItem "Prime Solution RFSP Brochure"
.AddItem "Prime Solution INT Thickener Brochure"
.AddItem "FOGRod Level Control Brochure"
.AddItem "FOGRod Level Control Presentation"
End With
End Sub

Then here is the code that calls for the object and has all the cases:

Public Sub AddOPEAttachments()

Dim objItem As Object
Dim oMail As Outlook.MailItem
Dim myAttachments As Outlook.Attachments

If TypeName(Application.ActiveInspector.CurrentItem) = "MailItem" Then
Set objItem = Application.ActiveInspector.CurrentItem
End If

Set myAttachments = objItem.Attachments

OPEAttachmentMenu.Show

Select Case lstNo
Case -1
'oMail.Subject = objItem.Subject
Case 0
myAttachments.Add "C:\OneDrive - Pump\Pump\Financial\W9 2020 NEW.pdf", _
olByValue, 1, "NOTHING"
' Pump Information
Case 1
myAttachments.Add "C:\OneDrive - Pump\ Pump\Financial\W9 2020 NEW.pdf", _
olByValue, 1, "Pump W9"
Case 2
myAttachments.Add "C:\OneDrive - Pump\Pump\Financial\Pump - Credit & Bank References.pdf", _
olByValue, 1, " Pump - Credit & Bank References"
Case 3
myAttachments.Add "C:\OneDrive - Pump\Pump\Forms DOC\General Information\Pump Credit Application.pdf", _
olByValue, 1, " Pump - Credit Application"
objItem.HTMLBody = "See the attached credit application and return, or complete it online at the link: " & vbNewLine & vbNewLine & "<a href=""http://credit.pump.com"">Click Here</a>"
Case 4
myAttachments.Add "C:\OneDrive - Pump\Pump\Financial\W9 2020 NEW.pdf", _
olByValue, 1, "NOTHING"
'Vogelsang Information
Case 5
myAttachments.Add "C:\OneDrive - Pump\Venders\Vogelsang\Brochures\Vogelsang Municipal Brochure.pdf", _
olByValue, 1, "Vogelsang Municipal Brochure"
Case 6
myAttachments.Add "C:\OneDrive - Pump\Venders\Vogelsang\Brochures\Vogelsang Wine Brochure-sm.pdf", _
olByValue, 1, "Vogelsang Wine Brochure"
Case 7
myAttachments.Add "C:\OneDrive - Pump\Venders\Vogelsang\Brochures\Vogelsang XRipper Buyers Guide 2019-sm.pdf", _
olByValue, 1, "Vogelsang XRipper Brochure"
'Barnes Information
Case 8
myAttachments.Add "C:\OneDrive - Pump\Venders\Crane Pump & Systems\Technical\Barnes Pump\Brochures\Barnes Sithe Brochure.pdf", _
olByValue, 1, "Barnes Sithe Brochure"
Case 9
myAttachments.Add "C:\OneDrive - Pump\Venders\Crane Pump & Systems\Technical\Barnes Pump\Brochures\Barnes SH Brochure.pdf", _
olByValue, 1, "Barnes SH Brochure"
Case 10
myAttachments.Add "C:\OneDrive - Pump\Venders\Crane Pump & Systems\Technical\Barnes Pump\Brochures\Barnes Razor Brochure.pdf", _
olByValue, 1, "Barnes Razor Brochure"
Case 11
myAttachments.Add "C:\OneDrive - Pump\Venders\Crane Pump & Systems\Technical\Barnes Pump\Brochures\2020 Pressure Sewer Market Brochure.pdf", _
olByValue, 1, "Barnes Pressure Sewer Brochure"
Case 12
myAttachments.Add "C:\OneDrive - Pump\Venders\Crane Pump & Systems\Technical\Barnes Pump\Brochures\2020 Upgrade Core Brochure.pdf", _
olByValue, 1, "Barnes Upgrade Cores Brochure"
Case 13
myAttachments.Add "C:\OneDrive - Pump\Venders\Crane Pump & Systems\Technical\Barnes Pump\Brochures\Barnes Blade Brochure XP sm.pdf", _
olByValue, 1, "Barnes Blade Brochure"
Case 14
myAttachments.Add "C:\OneDrive - Pump\Venders\Crane Pump & Systems\Technical\Barnes Pump\Brochures\Barnes Engineered Basins Brochurepdf", _
olByValue, 1, "Barnes FRP Engineered Basins Brochure"
'Mencarelli Information
Case 15
myAttachments.Add "C:\OneDrive - Pump\Venders\Mencarelli Pump & Valve\Brochure\Mencarelli Inox Pump Brochure - Wine OPE.pdf", _
olByValue, 1, "Mencarelli Wine Pump Brochure"
'WasteCorp Information
Case 16
myAttachments.Add "C:\OneDrive - Pump\Venders\WasteCorp Pumps\Brochures\WasteCorp Municipal Pumps Brochure.pdf", _
olByValue, 1, "WasteCorp Municipal Brochure"
Case 17
myAttachments.Add "C:\OneDrive - Pump\Venders\WasteCorp Pumps\Brochures\WasteCorp Industrial Pumps Brochure.pdf", _
olByValue, 1, "WasteCorp Municipal Brochure"
Case 18
myAttachments.Add "C:\OneDrive - Pump\Venders\WasteCorp Pumps\Brochures\WasteCorp Double-Disc Brochure.pdf", _
olByValue, 1, "WasteCorp Double-Disc Brochure"
Case 19
myAttachments.Add "C:\OneDrive - Pump\Venders\WasteCorp Pumps\Brochures\WasteCorp Trash Flow Self Priming Brochure.pdf", _
olByValue, 1, "WasteCorp Self-Priming Brochure"
Case 20
myAttachments.Add "C:\OneDrive - Pump\Venders\WasteCorp Pumps\Brochures\WasteCorp Pre-Packaged Lift Stations Brochure.pdf", _
olByValue, 1, "WasteCorp Pre-Packaged Lift Station Brochure"
'BioGill Information
Case 21
myAttachments.Add "C:\OneDrive - Pump\Venders\BioGill\Brochures\BioGill Tower Plus DataSheet.pdf", _
olByValue, 1, "BioGill Tower Plus Datasheet"
Case 22
myAttachments.Add "C:\OneDrive - Pump\Venders\BioGill\Brochures\BioGill Ultra DataSheet.pdf", _
olByValue, 1, "BioGill Ultra Datasheet"
Case 23
myAttachments.Add "C:\OneDrive - Pump\Venders\BioGill\Brochures\20180510BioGIllBreweryWastewaterTreatmentGuideVersion1.3.pdf", _
olByValue, 1, "BioGill Brewery Treatment Guide"
Case 24
myAttachments.Add "C:\OneDrive - Pump\Venders\BioGill\Brochures\20180606FoodBeverageOverview.pdf", _
olByValue, 1, "BioGill Food & Bev Overview"
'ARO Information
Case 25
myAttachments.Add "C:\OneDrive - Pump\Venders\ARO Pumps\Brochures & Flyers\ARO FDA Compliant AOD Pumps OPE.pdf", _
olByValue, 1, "ARO FDA & Food Diaphragm Pumps Brochure"
Case 26
myAttachments.Add "C:\OneDrive - Pump\Venders\Pumps\Brochures & Datasheets\1.5 TC AOD Wine Cart OP.pdf", _
olByValue, 1, "ARO 1.5 Inch Diaphragm Pump Cart Flyer"
Case 27
myAttachments.Add "C:\OneDrive - Pump\Venders\Pumps\Brochures & Datasheets\2.5 TC AOD Wine Cart OP.pdf", _
olByValue, 1, "ARO 2.5 Inch Diaphragm Pump Cart Flyer"
Case 28
myAttachments.Add "C:\OneDrive - Pump\Venders\ARO Pumps\Brochures & Flyers\EXP Metalic Pumps.pdf", _
End Select
End Sub

Function GetCurrentItem() As Object
Dim objApp As Outlook.Application

Set objApp = Application
On Error Resume Next
Select Case TypeName(objApp.ActiveWindow)
Case "Explorer"
Set GetCurrentItem = objApp.ActiveExplorer.Selection.Item(1)
Case "Inspector"
Set GetCurrentItem = objApp.ActiveInspector.CurrentItem
End Select

Set objApp = Nothing
End Function
 
This worked here - I used this for the button click

Code: 
Private Sub CommandButton1_Click()
Dim i As Long
Dim lngCount As Long
Dim strPicks As String
  lngCount = 0
  For i = 0 To ListBox1.ListCount - 1
    If ListBox1.Selected(i) = True Then
      lngCount = lngCount + 1
      If lngCount = 1 Then
        strPicks = ListBox1.List(i)
      Else
        strPicks = strPicks & "," & ListBox1.List(i)
      End If
    End If
  Next i
    lstText = strPicks
'MsgBox lstText

    Unload Me

lbl_Exit:
  Exit Sub
End Sub

these were my additems:
.AddItem "head2.csv"
.AddItem "head3.csv"
.AddItem "head4.csv"

I used the additem text as the select cases - split the array then got each file. If you can get the index #, of the Additem's you can use the case # instead -the command button code sample I had used the names, not the index # and I was too lazy to tweak it.

Code: 
Public lstText As String
Public Sub AddOPEAttachments()

Dim objItem As Object
Dim oMail As Outlook.MailItem
Dim myAttachments As Outlook.Attachments

Dim StrArr() As String

If TypeName(Application.ActiveInspector.currentItem) = "MailItem" Then
Set objItem = Application.ActiveInspector.currentItem
End If

Set myAttachments = objItem.Attachments

UserForm1.Show
StrArr = Split(lstText, ",")

For i = LBound(StrArr) To UBound(StrArr)
MsgBox StrArr(i)
Select Case StrArr(i)
Case -1
'oMail.Subject = objItem.Subject
Case "head2.csv"
myAttachments.Add "D:\OneDrive - Cdolive LLC dba Slipstick Systems\0 - Word\head2.csv", _
olByValue, 1, "head2.csv"
' Pump Information
Case "head3.csv"
myAttachments.Add "D:\OneDrive - Cdolive LLC dba Slipstick Systems\0 - Word\head3.csv", _
olByValue, 1, "head3.csv"
Case "head4.csv"
myAttachments.Add "D:\OneDrive - Cdolive LLC dba Slipstick Systems\0 - Word\head4.csv", _
olByValue, 1, "head4.csv"

End Select
Next i

End Sub
 
Ah heck with it... this will use the case # - the additem list needs to be in the same order and you need to make sure the numbers are right. Using the same itemadd list in my other post, my 3 test files are #5, 6, 7

Code: 
Private Sub btnOK_Click()
Dim i As Long
Dim lngCount As Long
Dim strPicks As String
  lngCount = 0
  For i = 0 To ListBox1.ListCount - 1
    If ListBox1.Selected(i) = True Then
      lngCount = lngCount + 1
      If lngCount = 1 Then
        strPicks = i 'ListBox1.List(i)
      Else
        strPicks = strPicks & "," & i
      End If
    End If
  Next i
    lstText = strPicks
MsgBox lstText

    Unload Me

lbl_Exit:
  Exit Sub
End Sub
 
Thank you!! Working perfectly!
Diane Poremsky said:
Ah heck with it... this will use the case # - the additem list needs to be in the same order and you need to make sure the numbers are right. Using the same itemadd list in my other post, my 3 test files are #5, 6, 7

Code: 
Private Sub btnOK_Click()
Dim i As Long
Dim lngCount As Long
Dim strPicks As String
  lngCount = 0
  For i = 0 To ListBox1.ListCount - 1
    If ListBox1.Selected(i) = True Then
      lngCount = lngCount + 1
      If lngCount = 1 Then
        strPicks = i 'ListBox1.List(i)
      Else
        strPicks = strPicks & "," & i
      End If
    End If
  Next i
    lstText = strPicks
MsgBox lstText

    Unload Me

lbl_Exit:
  Exit Sub
End Sub
Click to expand...
 
Status
Not open for further replies.
< SendAndReceive question | Macro for other actions - Outlook 2007 >
Similar threads
Thread starter Title Forum Replies Date
M Use VBA to filter contacts Using Outlook 2
C VBA in "New Outlook?" Using Outlook 0
efire9207 VBA Outlook Contacts Outlook VBA and Custom Forms 6
B Requesting VBA code to make Outlook prompt for confirmation when deleting a task? Outlook VBA and Custom Forms 4
M Outlook 365 VBA Auto-Forward Only the first of Duplicate Emails Outlook VBA and Custom Forms 2
N VBA Code Not Working correctly Outlook VBA and Custom Forms 1
L VBA to Triage Incoming Email Outlook VBA and Custom Forms 0
J Outlook VBA to send from Non-default Account & Data Files Outlook VBA and Custom Forms 4
H using VBA to edit subject line Outlook VBA and Custom Forms 0
G Get current open draft message body from VBA Outlook VBA and Custom Forms 1
P VBA to add email address to Outlook 365 rule Outlook VBA and Custom Forms 0
M Outlook 2016 outlook vba to look into shared mailbox Outlook VBA and Custom Forms 0
V VBA Categories unrelated to visible calendar and Visual appointment Categories Outlook VBA and Custom Forms 2
D Outlook VBA forward the selected email to the original sender’s email ID (including the email used in TO, CC Field) from the email chain Outlook VBA and Custom Forms 2
R Outlook 365 VBA AUTO SEND WITH DELAY FOR EACH EMAIL Outlook VBA and Custom Forms 0
R Outlook 2019 VBA to List Meetings in Rooms Outlook VBA and Custom Forms 0
geoffnoakes Counting and/or listing fired reminders via VBA Using Outlook 1
O VBA - Regex - remove double line spacing Outlook VBA and Custom Forms 1
D.Moore Strange VBA error Outlook VBA and Custom Forms 4
B Modify VBA to create a RULE to block multiple messages Outlook VBA and Custom Forms 0
D Outlook 2021 Using vba code to delete all my spamfolders not only the default one. Outlook VBA and Custom Forms 0
K vba code to auto download email into a specific folder in local hard disk as and when any new email arrives in Inbox/subfolder Outlook VBA and Custom Forms 0
D VBA - unable to set rule condition 'on this computer only' Outlook VBA and Custom Forms 5
L Fetch, edit and forward an email with VBA outlook Outlook VBA and Custom Forms 2
BartH VBA no longer working in Outlook Outlook VBA and Custom Forms 1
W Can vba(for outlook) do these 2 things or not? Outlook VBA and Custom Forms 2
MattC Changing the font of an email with VBA Outlook VBA and Custom Forms 1
P MailItem.To Property with VBA not work Outlook VBA and Custom Forms 2
P Tweak vba so it can target another mailbox Outlook VBA and Custom Forms 1
A Outlook 2010 VBA fails to launch Outlook VBA and Custom Forms 2
richardwing Outlook 365 VBA to access "Other Actions" menu for incoming emails in outlook Outlook VBA and Custom Forms 0
W Create a Quick Step or VBA to SAVE AS PDF in G:|Data|Client File Outlook VBA and Custom Forms 1
J Outlook Rules VBA Run a Script - Multiple Rules Outlook VBA and Custom Forms 0
C Outlook (desktop app for Microsoft365) restarts every time I save my VBA? Using Outlook 1
D VBA Macro to Print and Save email to network location Outlook VBA and Custom Forms 1
TedSch Small vba to kill political email Outlook VBA and Custom Forms 3
E Outlook 365 Outlook/VBA Outlook VBA and Custom Forms 11
N VBA Macro To Save Emails Outlook VBA and Custom Forms 1
Z VBA Forward vs manual forward Outlook VBA and Custom Forms 2
J VBA Cannot programmatically input or change Value for User Defined field Using Outlook 1
J VBA for outlook to compare and sync between calendar Outlook VBA and Custom Forms 1
A Any way to force sort by/group by on search results with VBA? Outlook VBA and Custom Forms 1
E Default shape via VBA Outlook VBA and Custom Forms 4
A Change settings Send/receive VBA Outlook VBA and Custom Forms 0
Z Import Tasks from Access Using VBA including User Defined Fields Outlook VBA and Custom Forms 0
E Outlook VBA change GetDefaultFolder dynamically Outlook VBA and Custom Forms 6
justicefriends How to set a flag to follow up using VBA - for addressee in TO field Outlook VBA and Custom Forms 11
M add new attendee to existing meetings with VBA Outlook VBA and Custom Forms 5
D VBA code to select a signature from the signatures list Outlook VBA and Custom Forms 3
D Create advanced search (email) via VBA with LONG QUERY (>1024 char) Outlook VBA and Custom Forms 2

Similar threads

Back
Top