Excel information

Most Popular Excel Questions


Posted by davesexcel on November 13, 2012 at 10:40 AM

Select a file to be emailed using excel VBA

This example uses three combo boxes to select the folder,file,then email address to send a file.

This 1st code will list the subfolders from the C:\ drive and populate a combobox that is on the worksheet. The combobox and command button are drawn from the controls toolbar and the code is located in the worksheet module.

Private Sub CommandButton1_Click()

    Dim fs, f, f1, fc, s

    Dim folderspec

    folderspec = "C:\"

    Set fs = CreateObject("Scripting.FileSystemObject")

    Set f = fs.GetFolder(folderspec)

    Set fc = f.SubFolders


    For Each f1 In fc

        ComboBox1.AddItem f1.Name

    Next f1


    Application.SendKeys "^{F4}"

End Sub

Once you have made a folder selection from combobox1, combobox2 then needs to be populated with the file names from the selected folder.

Private Sub ComboBox1_Change()

    Dim fs, f, f1, fc, s

    Dim folderspec

    folderspec = "C:\" & ComboBox1

    Set fs = CreateObject("Scripting.FileSystemObject")

    Set f = fs.GetFolder(folderspec)

    Set fc = f.Files


    For Each f1 In fc

        ComboBox2.AddItem f1.Name

    Next f1


    Application.SendKeys "^{F4}"

End Sub

Now combobox2 will dropdown, and you can select a file to be attached to your email.

Once you have selected a file to attach, a code will activate to populate combobox3 with a list of contacts from your Outlook Account. This macro is called "select_Email".

Private Sub ComboBox2_Change()



    Application.SendKeys "^{F4}"

End Sub



Code to get contacts list

Sub select_Email()

    Dim olApp As Object

    Dim Cbo As Object

    Dim Contact As Object

    Dim ContactsFolder As Object

    Set Cbo = Worksheets("Sheet1").OLEObjects("ComboBox3").Object


    Set olApp = CreateObject("Outlook.Application")

    Set ContactsFolder = olApp.Session.GetDefaultFolder(10)

    For Each Contact In ContactsFolder.Items

        Cbo.AddItem Contact.FullName

    Next Contact


    Set olApp = Nothing

End Sub



Now for the Email code

Sub SendEmail()

    Dim OutlookApp As Object

    Dim mItem As Object

    Dim Cell As Range

    Dim Subj As String

    Dim EmailAddr As String

    Dim Bonus As String

    Dim Msg As String

    Dim Body As String

    Set OutlookApp = CreateObject("Outlook.Application")

    Body = Range("D20")

    Subj = ActiveSheet.ComboBox2

    EmailAddr = ActiveSheet.ComboBox3

    Set mItem = OutlookApp.createitem(0)

    With mItem

        On Error GoTo ExitPoint

        strPath = "C:\" & ActiveSheet.ComboBox1 & "\" & ActiveSheet.ComboBox2

        vDir = Dir(strPath)

        .Attachments.Add Replace(strPath, "*.*", vDir)

        vDir = Dir()

        If .Attachments.Count = 0 Then

            If MsgBox("Invalid Path - Cancel Mail ?", vbYesNo, "Cancel") = vbYes Then


                GoTo ExitPoint

            End If

        End If

        .To = EmailAddr

        .Subject = Subj

        .Body = Body


    End With


    Set OLMsg = Nothing

End Sub



You may have noticed this bit of code in a few of the macros


Application.SendKeys "^{F4}"

This is used to auto drop the combobox.

Check out the example workbook




Categories: None

Post a Comment


Oops, you forgot something.


The words you entered did not match the given text. Please try again.

You must be a member to comment on this page. Sign In or Register