davesexcel.com

Excel information

Most Popular Excel Questions

EMAIL A FILE FROM EXCEL

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

    ComboBox1.Clear

    For Each f1 In fc

        ComboBox1.AddItem f1.Name

    Next f1

    ComboBox1.Activate

    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

    ComboBox2.Clear

    For Each f1 In fc

        ComboBox2.AddItem f1.Name

    Next f1

    ComboBox2.Activate

    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()

    select_Email

    ComboBox3.Activate

    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

    Cbo.Clear

    Set olApp = CreateObject("Outlook.Application")

    Set ContactsFolder = olApp.Session.GetDefaultFolder(10)

    For Each Contact In ContactsFolder.Items

        Cbo.AddItem Contact.FullName

    Next Contact

    olApp.Quit

    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

                .Delete

                GoTo ExitPoint

            End If

        End If

        .To = EmailAddr

        .Subject = Subj

        .Body = Body

        .display

    End With

ExitPoint:

    Set OLMsg = Nothing

End Sub

 

 


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


ComboBox2.Activate   

Application.SendKeys "^{F4}"


This is used to auto drop the combobox.


Check out the example workbook


http://www.davesexcel.com/Email%20A%20File.xlsm

http://www.davesexcel.com/Email%20A%20File.xls

 




Categories: None

Post a Comment

Oops!

Oops, you forgot something.

Oops!

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

0 Comments