Making an Email with attachment

[saloelrn1988]

Hi,

really need your advise

I'm trying to create a macro that creates an email with an attachment, however the code that I tried is giving me run time error please see below code:
Ps. the file that I tried to attached will vary depending on the month so I tried using some Cell that contains the folder and file name.


Sub Send_email()
'
' Send_email Macro
' Auto send email
'

' SET Outlook APPLICATION OBJECT.
Dim objOutlook As Object
Set objOutlook = CreateObject("Outlook.Application")

' CREATE EMAIL OBJECT.
Dim objEmail As Object
Dim pageEditor As Object
Dim xinspect As Object
Set objEmail = objOutlook.CreateItem(olMailItem)

With objEmail
.To = Worksheets("Email data").Range("B2")
.CC = Worksheets("Email data").Range("B3")
.Subject = Worksheets("Email data").Range("B4")
.body = Worksheets("Email data").Range("B5")
source_file = "C:\Users\reomon\Desktop\Accrual - OUS\" & Worksheets("Email data").Range("B6") & "\" & Worksheets("Email data").Range("B7")
.Attachments.Add source_file
.display

End With

' CLEAR.
Set objEmail = Nothing: Set objOutlook = Nothing

ErrHandler:
'
End Sub

 

[Logit]

Where does your code error and what is the error code ?

 

[DanteAmor]

Try this, to check if the file exists.

Write here literally what you have in cells B6 and B7

And put an image of windows explorer where i can see the folder name and file name.

Sub Send_email()
  Dim objOutlook As Object, objEmail As Object
  Dim sPath As String, sFile As String
  '
  Set objOutlook = CreateObject("Outlook.Application")
  Set objEmail = objOutlook.CreateItem(0)
  sPath = "C:\Users\reomon\Desktop\Accrual - OUS\"
  '
  With Worksheets("Email data")
    sFile = sPath & .Range("B6").Value & "\" & .Range("B7").Value
    If Dir(sFile) = "" Then
      MsgBox "File not found"
      Exit Sub
    End If
    objEmail.To = .Range("B2").Value
    objEmail.CC = .Range("B3").Value
    objEmail.Subject = .Range("B4").Value
    objEmail.body = .Range("B5").Value
    objEmail.Attachments.Add sFile
    objEmail.display
  End With
  ' CLEAR.
  Set objEmail = Nothing: Set objOutlook = Nothing
End Sub

 

[saloelrn1988]

Try this, to check if the file exists.

Write here literally what you have in cells B6 and B7

Try this, to check if the file exists.

Write here literally what you have in cells B6 and B7

And put an image of windows explorer where i can see the folder name and file name.

Sub Send_email()
  Dim objOutlook As Object, objEmail As Object
  Dim sPath As String, sFile As String
  '
  Set objOutlook = CreateObject("Outlook.Application")
  Set objEmail = objOutlook.CreateItem(0)
  sPath = "C:\Users\reomon\Desktop\Accrual - OUS\"
  '
  With Worksheets("Email data")
    sFile = sPath & .Range("B6").Value & "\" & .Range("B7").Value
    If Dir(sFile) = "" Then
      MsgBox "File not found"
      Exit Sub
    End If
    objEmail.To = .Range("B2").Value
    objEmail.CC = .Range("B3").Value
    objEmail.Subject = .Range("B4").Value
    objEmail.body = .Range("B5").Value
    objEmail.Attachments.Add sFile
    objEmail.display
  End With
  ' CLEAR.
  Set objEmail = Nothing: Set objOutlook = Nothing
End Sub

Sub Send_email()
  Dim objOutlook As Object, objEmail As Object
  Dim sPath As String, sFile As String
  '
  Set objOutlook = CreateObject("Outlook.Application")
  Set objEmail = objOutlook.CreateItem(0)
  sPath = "C:\Users\reomon\Desktop\Accrual - OUS\"
  '
  With Worksheets("Email data")
    sFile = sPath & .Range("B6").Value & "\" & .Range("B7").Value
    If Dir(sFile) = "" Then
      MsgBox "File not found"
      Exit Sub
    End If
    objEmail.To = .Range("B2").Value
    objEmail.CC = .Range("B3").Value
    objEmail.Subject = .Range("B4").Value
    objEmail.body = .Range("B5").Value
    objEmail.Attachments.Add sFile
    objEmail.display
  End With
  ' CLEAR.
  Set objEmail = Nothing: Set objOutlook = Nothing
End Sub

This works perfectly thanks!

 

[DanteAmor]

Glad we could help & thanks for the feedback