Email attachment code with email?

KainAussie

New Member
Joined
Jun 14, 2012
Messages
9
Hi,

i have a Excel document that i have created and i am trying to add a button so that after pressing the button asks for a email address and it sends the email with the subject "test email" using outlook could some one please help me out with this as i am not sure how to do it and my boss would like this done for his business so its easier to send out the quotes
 

Excel Facts

VLOOKUP to Left?
Use =VLOOKUP(A2,CHOOSE({1,2},$Z$1:$Z$99,$Y$1:$Y$99),2,False) to lookup Y values to left of Z values.

Michael M

Well-known Member
Joined
Oct 27, 2005
Messages
20,179
Office Version
  1. 2016
  2. 2013
  3. 2007
Platform
  1. Windows
Hi and welcome to the Board
This will save the active worksheet, send the e-Mail and then delete the temporary copy of the worksheet.

Code:
Sub Mail_ActiveSheet()
    Dim FileExtStr As String, FileFormatNum As Long, Sourcewb As Workbook
    Dim Destwb As Workbook, tempFilePath As String, tempFileName As String
    Dim OutApp As Object, OutMail As Object, ws As Worksheet, i As Long
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With
    Set Sourcewb = ActiveWorkbook
With ActiveWorkbook
        .SaveAs tempFilePath & tempFileName & FileExtStr
   Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
        With OutMail
            .To = "" 'Put either an E-Mail address or a refernce to a cell value
            .CC = ""
            .BCC = ""
            .Subject = "TEST MAIL"
            .Body = ""
            .Attachments.Add tempFilePath & tempFileName & FileExtStr
            .Display
            '.Send 'Send will send straight away or use .display to read the E-Mail before sending
        End With
    'Delete the file you have send
    ActiveWorkbook.Close Savechanges:=False
End With
Kill tempFilePath & tempFileName & FileExtStr
    Set OutMail = Nothing
    Set OutApp = Nothing
End If
Next i
Next ws
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
End Sub
 

Skybluekid

Well-known Member
Joined
Apr 17, 2012
Messages
830
Hi

Just seen this code and it may be answer to a question that I have had for a while

Just one thing, how do you reference a cell in the .To?

Chris
 

Michael M

Well-known Member
Joined
Oct 27, 2005
Messages
20,179
Office Version
  1. 2016
  2. 2013
  3. 2007
Platform
  1. Windows
Hi Chris
Lets say the E-mail address of the recipient is in cell A1.
The =.To line would then become
Code:
.To = Range("A1").value
 

KainAussie

New Member
Joined
Jun 14, 2012
Messages
9

ADVERTISEMENT

Hi,
i did that this is what i have
Code:
Private Sub CommandButton1_Click()
 Sub Mail_ActiveSheet()
    Dim FileExtStr As String, FileFormatNum As Long, Sourcewb As Workbook
    Dim Destwb As Workbook, tempFilePath As String, tempFileName As String
    Dim OutApp As Object, OutMail As Object, ws As Worksheet, i As Long
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With
    Set Sourcewb = ActiveWorkbook
With ActiveWorkbook
        .SaveAs tempFilePath & tempFileName & FileExtStr
   Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
        With OutMail
            .To = "" 'Put either an E-Mail address or a refernce to a cell value
            .CC = ""
            .BCC = ""
            .Subject = "TEST MAIL"
            .Body = ""
            .Attachments.Add tempFilePath & tempFileName & FileExtStr
            .Display
            '.Send 'Send will send straight away or use .display to read the E-Mail before sending
        End With
    'Delete the file you have send
    ActiveWorkbook.Close Savechanges:=False
End With
Kill tempFilePath & tempFileName & FileExtStr
    Set OutMail = Nothing
    Set OutApp = Nothing
End If
Next i
Next ws
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
End Sub

but i get a message "Compile error: expected end sub" and it highlights "Private Sub CommandButton1_Click()" in yellow
 

Michael M

Well-known Member
Joined
Oct 27, 2005
Messages
20,179
Office Version
  1. 2016
  2. 2013
  3. 2007
Platform
  1. Windows
Hi Chris
Remove the 2nd line
Code:
Sub Mail_ActiveSheet()
 

KainAussie

New Member
Joined
Jun 14, 2012
Messages
9

ADVERTISEMENT

Hi Chris
Remove the 2nd line
Code:
Sub Mail_ActiveSheet()

i did and im getting error "Compile error end if without block if"
and then it highlights private sub commandbutton1_click ()

and
End if under the line set outapp = nothing
 

Michael M

Well-known Member
Joined
Oct 27, 2005
Messages
20,179
Office Version
  1. 2016
  2. 2013
  3. 2007
Platform
  1. Windows
Try
Code:
Private Sub CommandButton1_Click()
   Dim FileExtStr As String, FileFormatNum As Long, Sourcewb As Workbook
    Dim Destwb As Workbook, tempFilePath As String, tempFileName As String
    Dim OutApp As Object, OutMail As Object
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With
    Set Sourcewb = ActiveWorkbook
With ActiveWorkbook
        .SaveAs tempFilePath & tempFileName & FileExtStr
   Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
        With OutMail
            .To = "" 'Put either an E-Mail address or a refernce to a cell value
            .CC = ""
            .BCC = ""
            .Subject = "TEST MAIL"
            .Body = ""
            .Attachments.Add tempFilePath & tempFileName & FileExtStr
            .Display
            '.Send 'Send will send straight away or use .display to read the E-Mail before sending
        End With
    'Delete the file you have send
    ActiveWorkbook.Close Savechanges:=False
End With
Kill tempFilePath & tempFileName & FileExtStr
    Set OutMail = Nothing
    Set OutApp = Nothing
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
End Sub
 

KainAussie

New Member
Joined
Jun 14, 2012
Messages
9
Try
Code:
Private Sub CommandButton1_Click()
   Dim FileExtStr As String, FileFormatNum As Long, Sourcewb As Workbook
    Dim Destwb As Workbook, tempFilePath As String, tempFileName As String
    Dim OutApp As Object, OutMail As Object
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With
    Set Sourcewb = ActiveWorkbook
With ActiveWorkbook
        .SaveAs tempFilePath & tempFileName & FileExtStr
   Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
        With OutMail
            .To = "" 'Put either an E-Mail address or a refernce to a cell value
            .CC = ""
            .BCC = ""
            .Subject = "TEST MAIL"
            .Body = ""
            .Attachments.Add tempFilePath & tempFileName & FileExtStr
            .Display
            '.Send 'Send will send straight away or use .display to read the E-Mail before sending
        End With
    'Delete the file you have send
    ActiveWorkbook.Close Savechanges:=False
End With
Kill tempFilePath & tempFileName & FileExtStr
    Set OutMail = Nothing
    Set OutApp = Nothing
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
End Sub

thx but
now i get Run time error '-2147024893 (800070003)': path does not exist. verify the path is correct

and when i click debug it highlights
.Attachments.Add tempFilePath & tempFileName & FileExtStr
 

Michael M

Well-known Member
Joined
Oct 27, 2005
Messages
20,179
Office Version
  1. 2016
  2. 2013
  3. 2007
Platform
  1. Windows
Aargh !!! This code just isn't coming together....I've rewritten it, and hopefully it's a bit simpler to run AND follow.....sorry :oops:
Code:
Sub EmailWithOutlook()
Dim oApp As Object, oMail As Object, WB As Workbook, fileName As String
Application.ScreenUpdating = False
ActiveSheet.Copy
Set WB = ActiveWorkbook
fileName = "Temp.xls"
On Error Resume Next
Kill "C:\" & fileName
On Error GoTo 0
WB.SaveAs fileName:="C:\" & fileName
    Set oApp = CreateObject("Outlook.Application")
    Set oMail = oApp.CreateItem(0)
        With oMail
             .To = "someone@somedomain.com" ' change to suit
             .CC = "change to suit"
             .BCC = "" ' change to suit
             .Subject = "Look at my workbook!" ' change to suit
             .Body = "" 'Insert body text if required
             .Attachments.Add WB.FullName
            .Display 'change to .Send if you don't want to chack the E-Mail first
        End With
    WB.ChangeFileAccess Mode:=xlReadOnly
    Kill WB.FullName
    WB.Close SaveChanges:=False
    Application.ScreenUpdating = True
    Set oMail = Nothing
    Set oApp = Nothing
End Sub
 

Watch MrExcel Video

Forum statistics

Threads
1,130,051
Messages
5,639,773
Members
417,112
Latest member
PachRedoc

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top