BigDawg15
Board Regular
- Joined
- Apr 23, 2018
- Messages
- 71
- Office Version
- 365
- 2016
- Platform
- Windows
Hello,
The First command button code lists files in a listbox on a userform. The second command button code is supposed to attach the selected files selected from the listbox
to an email, however it is only attaching the last file selected. Can anyone help change the code to attach all selected files? The rest of the code is below.
Thank you,
BigDawg
The First command button code lists files in a listbox on a userform. The second command button code is supposed to attach the selected files selected from the listbox
to an email, however it is only attaching the last file selected. Can anyone help change the code to attach all selected files? The rest of the code is below.
Thank you,
BigDawg
VBA Code:
Private Sub CommandButton1_Click()
Erase PDFvarPath: Erase PDFvarName
Erase DocxvarPath: Erase DocxvarName
SearchString = Me.TextBox1.Value
Me.ListBox1.Clear
Me.ListBox2.Clear
If Not IsNumeric(SearchString) Then
MsgBox "Only numeric characters"
Me.TextBox1.Text = ""
GoTo jump1
End If
If Me.TextBox1.Text = "" Then GoTo jump1
Call loopAllSubFolderSelectStartDirectory
On Error Resume Next
If Len(Join(PDFvarName)) > 0 Then
Me.ListBox1.List = PDFvarName
ListBox1.Enabled = True
ListBox1.ForeColor = vbBlack
Else
Me.ListBox1.List = Array("Not Found")
ListBox1.Enabled = False
ListBox1.ForeColor = RGB(128, 128, 128)
End If
If Len(Join(DocxvarName)) > 0 Then
Me.ListBox2.List = DocvarName
ListBox2.Enabled = True
ListBox2.ForeColor = vbBlack
Else
Me.ListBox2.List = Array("Not Found")
ListBox2.Enabled = False
ListBox2.ForeColor = RGB(128, 128, 128)
End If
On Error GoTo 0
Exit Sub
jump1:
Me.ListBox1.Clear
Me.ListBox2.Clear
End Sub
Private Sub CommandButton2_Click()
Dim strBody As String, strbody2 As String
Dim OutlookApp As Object
Dim OutlookMail As Object
On Error Resume Next
strbody2 = "<BODY style=font-size:11pt;font-family:Calibri>Kind regards,</BODY>"
strBody = "<BODY style=font-size:11pt;font-family:Calibri>Hello, <p>" & "Please find attached January data files for your review.</p></BODY>"
Set OutlookApp = CreateObject("Outlook.Application")
Set OutlookMail = OutlookApp.CreateItem(0)
With OutlookMail
.Display
.To = "Test1@aaa.com"
.CC = "Test2@aaa.com"
.Subject = "Email Data Files"
.HTMLbody = strbody2 & .HTMLbody
.HTMLbody = strBody & .HTMLbody
.Attachments.Add PDFvarPath(Me.ListBox1.ListIndex + 1)
.Attachments.Add DocxvarPath(Me.ListBox2.ListIndex + 1)
End With
Set OutlookMail = Nothing
Set OutlookApp = Nothing
End Sub
Option Base 1
Global SearchString As String
Global PDFvarPath() As String, PDFvarName() As String
Global DocxvarPath() As String, DocxvarName() As String
Sub loopAllSubFolderSelectStartDirectory()
Dim FSOLibrary As Object, FSOFolder As Object, folderName As String
'folderName = Sheet1.Range("E4") & Application.Floor(Left(UserForm1.TextBox1, 2), 10) & "\"
folderName = Sheet1.Range("E4")
Set FSOLibrary = CreateObject("Scripting.FileSystemObject")
On Error GoTo errHand
LoopAllSubFolders FSOLibrary.GetFolder(folderName)
On Error GoTo 0
Exit Sub
errHand:
MsgBox "Folder not found"
UserForm1.TextBox1.Text = ""
End Sub
Sub LoopAllSubFolders(FSOFolder As Object)
Dim FSOSubFolder As Object
Dim FSOFile As Object, FSO As Object
Dim tmpVal As String, ext As String
Set FSO = CreateObject("Scripting.FileSystemObject")
Range("E" & Range("E" & Rows.Count).End(xlUp).Row + 1).Value = FSOFolder.Path
For Each FSOSubFolder In FSOFolder.SubFolders
LoopAllSubFolders FSOSubFolder
Next
For Each FSOFile In FSOFolder.Files
ext = LCase(FSO.GetExtensionName(FSOFile.Path))
tmpVal = FSOFile.Name
tmpVal = Left(tmpVal, InStrRev(tmpVal, ".") - 1)
tmpVal = Split(tmpVal, "_")(0)
tmpVal = Split(tmpVal, ".")(0)
If tmpVal = SearchString Then
If ext = "pdf" Then
x = x + 1
ReDim Preserve PDFvarPath(x): PDFvarPath(x) = FSOFile.Path
ReDim Preserve PDFvarName(x): PDFvarName(x) = FSOFile.Name
ElseIf ext = "docx" Then
y = y + 1
ReDim Preserve DocxvarPath(y): DocxvarPath(y) = FSOFile.Path
ReDim Preserve DocxvarName(y): DocxvarName(y) = FSOFile.Name
End If
End If
Next
x = 0
y = 0
End Sub
Sub LaunchForm()
UserForm1.Show
End Sub
