View Single Post
 
Old 03-05-2016, 12:22 AM
gmayor's Avatar
gmayor gmayor is offline Windows 10 Office 2016
Expert
 
Join Date: Aug 2014
Posts: 4,106
gmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud of
Default

I have recreated your folder on my network and provided you have the backslash at the end of the path (your's doesn't) it works OK
Code:
Option Explicit

Sub AttachPDFs()
Dim olItem As Outlook.MailItem
Dim olAttachments As Outlook.Attachments
Dim strPath As String
Dim strFile As String
Dim i As Long
Dim oFrm As New UserForm1
    With oFrm
        .Caption = "Select files to attach"
        .Height = 272
        .Width = 240
        .CommandButton1.Caption = "Continue"
        .CommandButton1.Top = 210
        .CommandButton1.Width = 72
        .CommandButton1.Left = 132
        .CommandButton2.Caption = "Cancel"
        .CommandButton2.Top = 210
        .CommandButton2.Width = 72
        .CommandButton2.Left = 18
        .ListBox1.Top = 12
        .ListBox1.Left = 18
        .ListBox1.Height = 192
        .ListBox1.Width = 189
        .ListBox1.MultiSelect = fmMultiSelectMulti
        'If the files are always in the same folder you could set strPath to that folder e.g.
        strPath = "X:\_sponsor_folder\"
        strFile = Dir$(strPath & "*.pdf")
        While Not strFile = ""
            On Error GoTo err_Handler
            .ListBox1.AddItem strFile
            strFile = Dir$()
        Wend
        .Show
        If .Tag = 1 Then
            Set olItem = Application.CreateItem(olMailItem)
            Set olAttachments = olItem.Attachments
            For i = 0 To .ListBox1.ListCount - 1
                If .ListBox1.Selected(i) Then
                    olAttachments.Add strPath & .ListBox1.List(i), _
                                      olByValue, 1
                End If
            Next i

            olItem.Display
        End If
    End With
    Unload oFrm

lbl_Exit:
    Set olItem = Nothing
    Set olAttachments = Nothing
    Set oFrm = Nothing
    Exit Sub
err_Handler:
    MsgBox Err.Number & vbCr & Err.Description
    Err.Clear
    GoTo lbl_Exit
End Sub
__________________
Graham Mayor - MS MVP (Word) (2002-2019)
Visit my web site for more programming tips and ready made processes www.gmayor.com
Reply With Quote