ffbaker632
New Member
- Joined
- Jan 23, 2021
- Messages
- 3
- Office Version
- 2016
- Platform
- Windows
I'm trying to run this email code and I'm getting a Compile Error Sub or Function not defined, what am I doing wrong?
Code:
Sub Mail_small_Text_And_JPG_Range_Outlook()
'This macro use the function named : CopyRangeToJPG
Dim OutApp As Object
Dim OutMail As Object
Dim strbody As String
Dim MakeJPG As String
With Application
.EnableEvents = False
.ScreenUpdating = False
End With
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
strbody = ""
MakeJPG = Battalion_1_Daily_Staffing("Sheet1")("A1:I27")
If MakeJPG = "" Then
MsgBox "Something go wrong, we can't create the mail"
With Application
.EnableEvents = True
.ScreenUpdating = True
End With
Exit Sub
End If
On Error Resume Next
With OutMail
.To = .Union("abc@domain.com")("xyz@gmail.com")
.CC = ""
.BCC = ""
.Subject = "Battalion 1 Daily Staffing"
.Attachments.Add MakeJPG, 1, 0
'Note: Change the width and height as needed
.HTMLBody = "<html><p>" & strbody & "</p><img src=""cid:NamePicture.jpg"" width=750 height=700></html>"
.Display 'or use .Send
End With
On Error GoTo 0
With Application
.EnableEvents = True
.ScreenUpdating = True
End With
Set OutMail = Nothing
Set OutApp = Nothing
End Sub
Function CopyRangeToJPG(NameWorksheet As String, RangeAddress As String) As String
Dim PictureRange As Range
With ActiveWorkbook
On Error Resume Next
.Worksheets("Sheet1").Activate
Set PictureRange = .Worksheets(Sheet1).Range("A1:I27")
If PictureRange Is Nothing Then
MsgBox "Sorry this is not a correct range"
On Error GoTo 0
Exit Function
End If
PictureRange.CopyPicture
With .Worksheets("Sheet1").ChartObjects.Add(PictureRange.Left, PictureRange.Top, PictureRange.Width, PictureRange.Height)
.Activate
.Chart.Paste
.Chart.Export Environ$("temp") & Application.PathSeparator & "NamePicture.jpg", "JPG"
End With
.Worksheets("Sheet1").ChartObjects(.Worksheets("Sheet1").ChartObjects.Count).Delete
End With
CopyRangeToJPG = Environ$("temp") & Application.PathSeparator & "NamePicture.jpg"
Set PictureRange = Nothing
End FunctionAttachments
Last edited by a moderator:
