Email attachment code with email?

[KainAussie]

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

 

[Michael M]

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.

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]

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]

Hi Chris
Lets say the E-mail address of the recipient is in cell A1.
The =.To line would then become

.To = Range("A1").value

 

[KainAussie]

Hi,
i did that this is what i have

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]

Hi Chris
Remove the 2nd line

Sub Mail_ActiveSheet()

 

[KainAussie]

Hi Chris
Remove the 2nd line

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]

Try

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]

Try

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]

Aargh !!! This code just isn't coming together....I've rewritten it, and hopefully it's a bit simpler to run AND follow.....sorry

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