Microsoft Office Forums

Go Back   Microsoft Office Forums > >

 
 
Thread Tools Display Modes
Prev Previous Post   Next Post Next
  #6  
Old 03-02-2016, 07:26 AM
gmayor's Avatar
gmayor gmayor is offline Macros to add attachments to an outlook e-mail Windows 10 Macros to add attachments to an outlook e-mail Office 2016
Expert
 
Join Date: Aug 2014
Posts: 4,144
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 ofgmayor has much to be proud of
Default

The main problem is that the file brower used by the in-built function is better than the one used by Outlook VBA, so you have to cobble something together which may not be as convenient. e.g. Create a VBA userform with a list box and two command buttons beneath it. The sizes don't matter as they are set in the macro. Use the default names.

The first code block below is the Userform code.
Code:
Option Explicit

Private Sub CommandButton1_Click()
    Me.Hide
    Me.Tag = 1
End Sub

Private Sub CommandButton2_Click()
    Me.Hide
    Me.Tag = 0
End Sub
The following goes in an ordinary module and is run to call the userform from which you can pick the PDFs to add to a new message
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
        strPath = BrowseForFolder & Chr(92) 
        'If the files are always in the same folder you coiuld set strPath to that folder e.g.
        'strPath = "C:\Path\"
        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

Function BrowseForFolder(Optional OpenAt As Variant) As Variant
Dim ShellApp As Object
    Set ShellApp = CreateObject("Shell.Application"). _
                   BrowseForFolder(0, "Please choose a folder", 0, OpenAt)

    On Error Resume Next
    BrowseForFolder = ShellApp.self.Path
    On Error GoTo 0

    Set ShellApp = Nothing
    Select Case Mid(BrowseForFolder, 2, 1)
        Case Is = ":"
            If Left(BrowseForFolder, 1) = ":" Then GoTo Invalid
        Case Is = "\"
            If Not Left(BrowseForFolder, 1) = "\" Then GoTo Invalid
        Case Else
            GoTo Invalid
    End Select
lbl_Exit:
    Set ShellApp = Nothing
    Exit Function
Invalid:
    BrowseForFolder = False
    GoTo lbl_Exit
End Function
__________________
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
 



Similar Threads
Thread Thread Starter Forum Replies Last Post
Shortcut for downloading attachments in e-mail paik1002 Outlook 4 12-11-2015 03:01 AM
Macros to add attachments to an outlook e-mail Move and Delete Mail Without Attachments rambler289 Outlook 1 09-29-2015 09:33 PM
Adding attachments to (e)mail-mege message Roger Keeling Mail Merge 2 05-23-2015 06:04 AM
Mail merge with personalized attachments sharke Outlook 0 07-01-2011 07:16 AM
Macros to add attachments to an outlook e-mail Can't See Attachments When E-mail String is Saved to PDF wineattorney Outlook 1 03-29-2011 02:15 AM

Other Forums: Access Forums

All times are GMT -7. The time now is 03:23 PM.


Powered by vBulletin® Version 3.8.11
Copyright ©2000 - 2025, vBulletin Solutions Inc.
Search Engine Optimisation provided by DragonByte SEO (Lite) - vBulletin Mods & Addons Copyright © 2025 DragonByte Technologies Ltd.
MSOfficeForums.com is not affiliated with Microsoft