Modify VBA code for automatic emails

[Jhaynes1011]

Hi, I have this code below that would work perfect for me if it would attached the existing sheet as a PDF.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim xRgPre As Range
On Error Resume Next
If Target.Cells.Count > 1 Then Exit Sub
Set xRg = Range("D7")
Set xRgPre = xRg.Precedents
If xRg.Value > 200 Then
If Target.Address = xRg.Address Then
Call Mail_small_Text_Outlook
ElseIf (Not xRgPre Is Nothing) And (Intersect(Target, xRgPre).Address = Target.Address) Then
Call Mail_small_Text_Outlook
End If
End If
End Sub
Sub Mail_small_Text_Outlook()
Dim xOutApp As Object
Dim xOutMail As Object
Dim xMailBody As String
Set xOutApp = CreateObject("Outlook.Application")
Set xOutMail = xOutApp.CreateItem(0)
xMailBody = "Hi there" & vbNewLine & vbNewLine & _
"This is line 1" & vbNewLine & _
"This is line 2"
On Error Resume Next
With xOutMail
.To = "Email Address"
.CC = ""
.BCC = ""
.Subject = "send by cell value test"
.Body = xMailBody
.Display 'or use .Send
End With
On Error GoTo 0
Set xOutMail = Nothing
Set xOutApp = Nothing
End Sub​

 

[ranman256]

Im guessing at where you want the file made.

Option Explicit


'------------
Private Sub Worksheet_Change(ByVal Target As Range)
'------------
Dim xRgPre As Range
Dim vFile, vPtr


On Error Resume Next


If Target.Cells.Count > 1 Then Exit Sub


Set xRg = Range("D7")
Set xRgPre = xRg.Precedents


  'save the pdf
vFile = "c:\temp\MyFile.pdf"
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=vFile, Quality:= _
        xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
        OpenAfterPublish:=True




If xRg.Value > 200 Then
    If Target.Address = xRg.Address Then
        Mail_small_Text_Outlook vFile
    ElseIf (Not xRgPre Is Nothing) And (Intersect(Target, xRgPre).Address = Target.Address) Then
        Mail_small_Text_Outlook vFile
    End If
End If
End Sub


'------------
Sub Mail_small_Text_Outlook(Optional pvFile)
'------------
Dim xOutApp As Outlook.Application
Dim xOutMail As Outlook.MailItem
Dim xMailBody As String


Set xOutApp = CreateObject("Outlook.Application")
Set xOutMail = xOutApp.CreateItem(0)


On Error Resume Next


xMailBody = "Hi there" & vbNewLine & vbNewLine & _
"This is line 1" & vbNewLine & _
"This is line 2"


With xOutMail
    .To = "Email Address"
    .CC = ""
    .BCC = ""
    .Subject = "send by cell value test"
    .Body = xMailBody
    
     If Not IsMissing(pvFile) Then .Attachments.Add pvFile, olByValue, 1
    
    .Display     'or use .Send
End With


On Error GoTo 0
Set xOutMail = Nothing
Set xOutApp = Nothing
End Sub

 

[Jhaynes1011]

Thank you for taking time to look at this.

I am getting a compile error, variable not defined.

Im guessing at where you want the file made.

Option Explicit


'------------
Private Sub Worksheet_Change(ByVal Target As Range)
'------------
Dim xRgPre As Range
Dim vFile, vPtr


On Error Resume Next


If Target.Cells.Count > 1 Then Exit Sub


Set xRg = Range("D7")
Set xRgPre = xRg.Precedents


  'save the pdf
vFile = "c:\temp\MyFile.pdf"
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=vFile, Quality:= _
        xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
        OpenAfterPublish:=True




If xRg.Value > 200 Then
    If Target.Address = xRg.Address Then
        Mail_small_Text_Outlook vFile
    ElseIf (Not xRgPre Is Nothing) And (Intersect(Target, xRgPre).Address = Target.Address) Then
        Mail_small_Text_Outlook vFile
    End If
End If
End Sub


'------------
Sub Mail_small_Text_Outlook(Optional pvFile)
'------------
Dim xOutApp As Outlook.Application
Dim xOutMail As Outlook.MailItem
Dim xMailBody As String


Set xOutApp = CreateObject("Outlook.Application")
Set xOutMail = xOutApp.CreateItem(0)


On Error Resume Next


xMailBody = "Hi there" & vbNewLine & vbNewLine & _
"This is line 1" & vbNewLine & _
"This is line 2"


With xOutMail
    .To = "Email Address"
    .CC = ""
    .BCC = ""
    .Subject = "send by cell value test"
    .Body = xMailBody
    
     If Not IsMissing(pvFile) Then .Attachments.Add pvFile, olByValue, 1
    
    .Display     'or use .Send
End With


On Error GoTo 0
Set xOutMail = Nothing
Set xOutApp = Nothing
End Sub

 

[ranman256]

sorry, instead of :Worksheet_Change(ByVal Target As Range)

use
Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)