Run Time Error 438 Help

bloodmilksky

Board Regular
Joined
Feb 3, 2016
Messages
202
Hi Guys,

I am trying to automate the emailing of a Range using the below, but I am getting a Run Time Error 438.

can anyone help.


Code:
Sub EMAIL_Mail_Test()    With Sheets("Sheet1")
.Range("E2").CopySheets("Sheet2").Range ("B7")
Mail_Range.Mail_Range
.Range("E4").CopySheets("Sheet2").Range ("B7")
Mail_Range.Mail_Range
.Range("E5").CopySheets("Sheet2").Range ("B7")
Mail_Range.Mail_Range
.Range("E6").CopySheets("Sheet2").Range ("B7")
Mail_Range.Mail_Range
.Range("E7").CopySheets("Sheet2").Range ("B7")
Mail_Range.Mail_Range
.Range("E8").CopySheets("Sheet2").Range ("B7")
Mail_Range.Mail_Range
.Range("E9").CopySheets("Sheet2").Range ("B7")
Mail_Range.Mail_Range
.Range("E10").CopySheets("Sheet2").Range ("B7")
Mail_Range.Mail_Range
.Range("E11").CopySheets("Sheet2").Range ("B7")
Mail_Range.Mail_Range
.Range("E12").CopySheets("Sheet2").Range ("B7")
Mail_Range.Mail_Range
.Range("E13").CopySheets("Sheet2").Range ("B7")
Mail_Range.Mail_Range
.Range("E14").CopySheets("Sheet2").Range ("B7")
Mail_Range.Mail_Range
.Range("E15").CopySheets("Sheet2").Range ("B7")
Mail_Range.Mail_Range
.Range("E16").CopySheets("Sheet2").Range ("B7")
Mail_Range.Mail_Range
.Range("E17").CopySheets("Sheet2").Range ("B7")
Mail_Range.Mail_Range
.Range("E18").CopySheets("Sheet2").Range ("B7")
Mail_Range.Mail_Range
.Range("E19").CopySheets("Sheet2").Range ("B7")
Mail_Range.Mail_Range
.Range("E20").CopySheets("Sheet2").Range ("B7")
Mail_Range.Mail_Range
.Range("E21").CopySheets("Sheet2").Range ("B7")
Mail_Range.Mail_Range
Mail_Range.Mail_Range
.Range("E22").CopySheets("Sheet2").Range ("B7")
Mail_Range.Mail_Range
.Range("E23").CopySheets("Sheet2").Range ("B7")
Mail_Range.Mail_Range
.Range("E24").CopySheets("Sheet2").Range ("B7")
Mail_Range.Mail_Range
.Range("E25").CopySheets("Sheet2").Range ("B7")
Mail_Range.Mail_Range
.Range("E26").CopySheets("Sheet2").Range ("B7")
Mail_Range.Mail_Range
.Range("E27").CopySheets("Sheet2").Range ("B7")
Mail_Range.Mail_Range
.Range("E28").CopySheets("Sheet2").Range ("B7")
Mail_Range.Mail_Range
.Range("E29").CopySheets("Sheet2").Range ("B7")
Mail_Range.Mail_Range
.Range("E30").CopySheets("Sheet2").Range ("B7")
Mail_Range.Mail_Range
.Range("E31").CopySheets("Sheet2").Range ("B7")
Mail_Range.Mail_Range
.Range("E32").CopySheets("Sheet2").Range ("B7")
Mail_Range.Mail_Range
.Range("E33").CopySheets("Sheet2").Range ("B7")
Mail_Range.Mail_Range
.Range("E34").CopySheets("Sheet2").Range ("B7")
Mail_Range.Mail_Range
.Range("E35").CopySheets("Sheet2").Range ("B7")
Mail_Range.Mail_Range
.Range("E36").CopySheets("Sheet2").Range ("B7")
Mail_Range.Mail_Range
.Range("E37").CopySheets("Sheet2").Range ("B7")
Mail_Range.Mail_Range
.Range("E38").CopySheets("Sheet2").Range ("B7")
Mail_Range.Mail_Range
.Range("E39").CopySheets("Sheet2").Range ("B7")
Mail_Range.Mail_Range
.Range("E40").CopySheets("Sheet2").Range ("B7")
Mail_Range.Mail_Range
.Range("E41").CopySheets("Sheet2").Range ("B7")
Mail_Range.Mail_Range
.Range("E42").CopySheets("Sheet2").Range ("B7")
Mail_Range.Mail_Range
.Range("E43").CopySheets("Sheet2").Range ("B7")
Mail_Range.Mail_Range
.Range("E44").CopySheets("Sheet2").Range ("B7")
Mail_Range.Mail_Range
.Range("E45").CopySheets("Sheet2").Range ("B7")
Mail_Range.Mail_Range
.Range("E46").CopySheets("Sheet2").Range ("B7")
Mail_Range.Mail_Range
.Range("E47").CopySheets("Sheet2").Range ("B7")
Mail_Range.Mail_Range
.Range("E48").CopySheets("Sheet2").Range ("B7")
Mail_Range.Mail_Range
.Range("E49").CopySheets("Sheet2").Range ("B7")
Mail_Range.Mail_Range
.Range("E50").CopySheets("Sheet2").Range ("B7")
Mail_Range.Mail_Range
.Range("E51").CopySheets("Sheet2").Range ("B7")
Mail_Range.Mail_Range
.Range("E52").CopySheets("Sheet2").Range ("B7")
Mail_Range.Mail_Range
.Range("E53").CopySheets("Sheet2").Range ("B7")
Mail_Range.Mail_Range
.Range("E54").CopySheets("Sheet2").Range ("B7")
Mail_Range.Mail_Range
.Range("E55").CopySheets("Sheet2").Range ("B7")
Mail_Range.Mail_Range
.Range("E56").CopySheets("Sheet2").Range ("B7")
Mail_Range.Mail_Range
.Range("E57").CopySheets("Sheet2").Range ("B7")
Mail_Range.Mail_Range
.Range("E58").CopySheets("Sheet2").Range ("B7")
Mail_Range.Mail_Range
.Range("E59").CopySheets("Sheet2").Range ("B7")
Mail_Range.Mail_Range
.Range("E60").CopySheets("Sheet2").Range ("B7")
Mail_Range.Mail_Range
.Range("E61").CopySheets("Sheet2").Range ("B7")
Mail_Range.Mail_Range
.Range("E62").CopySheets("Sheet2").Range ("B7")
Mail_Range.Mail_Range
.Range("E63").CopySheets("Sheet2").Range ("B7")
Mail_Range.Mail_Range
.Range("E64").CopySheets("Sheet2").Range ("B7")
Mail_Range.Mail_Range
.Range("E65").CopySheets("Sheet2").Range ("B7")
Mail_Range.Mail_Range
.Range("E66").CopySheets("Sheet2").Range ("B7")
Mail_Range.Mail_Range
.Range("E67").CopySheets("Sheet2").Range ("B7")
Mail_Range.Mail_Range
.Range("E68").CopySheets("Sheet2").Range ("B7")
Mail_Range.Mail_Range
.Range("E69").CopySheets("Sheet2").Range ("B7")
Mail_Range.Mail_Range
.Range("E70").CopySheets("Sheet2").Range ("B7")
Mail_Range.Mail_Range
.Range("E71").CopySheets("Sheet2").Range ("B7")
Mail_Range.Mail_Range
.Range("E72").CopySheets("Sheet2").Range ("B7")
Mail_Range.Mail_Range
.Range("E73").CopySheets("Sheet2").Range ("B7")
Mail_Range.Mail_Range
.Range("E74").CopySheets("Sheet2").Range ("B7")
Mail_Range.Mail_Range
.Range("E75").CopySheets("Sheet2").Range ("B7")
Mail_Range.Mail_Range
.Range("E76").CopySheets("Sheet2").Range ("B7")
Mail_Range.Mail_Range
.Range("E77").CopySheets("Sheet2").Range ("B7")
Mail_Range.Mail_Range
.Range("E78").CopySheets("Sheet2").Range ("B7")
Mail_Range.Mail_Range
.Range("E79").CopySheets("Sheet2").Range ("B7")
Mail_Range.Mail_Range
.Range("E80").CopySheets("Sheet2").Range ("B7")
Mail_Range.Mail_Range
.Range("E81").CopySheets("Sheet2").Range ("B7")
Mail_Range.Mail_Range
.Range("E82").CopySheets("Sheet2").Range ("B7")
Mail_Range.Mail_Range
.Range("E83").CopySheets("Sheet2").Range ("B7")
Mail_Range.Mail_Range
.Range("E84").CopySheets("Sheet2").Range ("B7")
Mail_Range.Mail_Range
.Range("E85").CopySheets("Sheet2").Range ("B7")
Mail_Range.Mail_Range
MsgBox ("All Done")
    End With
End Sub
 

CalcSux78

Well-known Member
Joined
Oct 15, 2013
Messages
1,120
from Ron de Bruin: https://www.rondebruin.nl/win/s1/outlook/bmail2.htm

Code:
Sub Mail_Selection_Range_Outlook_Body()
[COLOR=black]'For Tips see: http://www.rondebruin.nl/win/winmail/Outlook/tips.htm
'Don't forget to copy the function RangetoHTML in the module.
'Working in Excel 2000-2016[/COLOR]
    Dim rng As Range
    Dim OutApp As Object
    Dim OutMail As Object

    Set rng = Nothing
    On Error Resume Next
    [COLOR=black]'Only the visible cells in the selection[/COLOR]
    'Set rng = Selection.SpecialCells(xlCellTypeVisible)
    [COLOR=black]'You can also use a fixed range if you want
    Set rng = Sheets("Sheet1").Range("E2:E85").SpecialCells(xlCellTypeVisible)[/COLOR]
    On Error GoTo 0

    If rng Is Nothing Then
        MsgBox "The selection is not a range or the sheet is protected" & _
               vbNewLine & "please correct and try again.", vbOKOnly
        Exit Sub
    End If

    With Application
        .EnableEvents = False
        .ScreenUpdating = False
    End With

    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)

    On Error Resume Next
    With OutMail
        .To = "ron@debruin.nl"
        .CC = ""
        .BCC = ""
        .Subject = "This is the Subject line"
        .HTMLBody = RangetoHTML(rng)
        .Send   [COLOR=black]'or use .Display[/COLOR]
    End With
    On Error GoTo 0

    With Application
        .EnableEvents = True
        .ScreenUpdating = True
    End With

    Set OutMail = Nothing
    Set OutApp = Nothing
End Sub
Code:
Function RangetoHTML(rng As Range)
[COLOR=black]' Changed by Ron de Bruin 28-Oct-2006
' Working in Office 2000-2016
    Dim fso As Object[/COLOR]
    Dim ts As Object
    Dim TempFile As String
    Dim TempWB As Workbook

    TempFile = Environ$("temp") & "\" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"

    [COLOR=black]'Copy the range and create a new workbook to past the data in[/COLOR]
    rng.Copy
    Set TempWB = Workbooks.Add(1)
    With TempWB.Sheets(1)
        .Cells(1).PasteSpecial Paste:=8
        .Cells(1).PasteSpecial xlPasteValues, , False, False
        .Cells(1).PasteSpecial xlPasteFormats, , False, False
        .Cells(1).Select
        Application.CutCopyMode = False
        On Error Resume Next
        .DrawingObjects.Visible = True
        .DrawingObjects.Delete
        On Error GoTo 0
    End With

    [COLOR=black]'Publish the sheet to a htm file[/COLOR]
    With TempWB.PublishObjects.Add( _
         SourceType:=xlSourceRange, _
         Filename:=TempFile, _
         Sheet:=TempWB.Sheets(1).Name, _
         Source:=TempWB.Sheets(1).UsedRange.Address, _
         HtmlType:=xlHtmlStatic)
        .Publish (True)
    End With

    [COLOR=black]'Read all data from the htm file into RangetoHTML[/COLOR]
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
    RangetoHTML = ts.readall
    ts.Close
    RangetoHTML = Replace(RangetoHTML, "align=center x:publishsource=", _
                          "align=left x:publishsource=")

    [COLOR=black]'Close TempWB[/COLOR]
    TempWB.Close savechanges:=False

    [COLOR=black]'Delete the htm file we used in this function[/COLOR]
    Kill TempFile

    Set ts = Nothing
    Set fso = Nothing
    Set TempWB = Nothing [COLOR=#3366CC]End Function
[/COLOR]
 

Norie

Well-known Member
Joined
Apr 28, 2004
Messages
75,362
Office Version
365
Platform
Windows
Shouldn't there be a space between Copy and Sheets?
Code:
Sub EMAIL_Mail_Test()   

    With Sheets("Sheet1")
        .Range("E2").Copy Sheets("Sheet2").Range ("B7")
        Mail_Range.Mail_Range
        .Range("E4").Copy Sheets("Sheet2").Range ("B7")
        Mail_Range.Mail_Range
         .Range("E5").Copy Sheets("Sheet2").Range ("B7")
        Mail_Range.Mail_Range
        ' etc...
 

Forum statistics

Threads
1,081,706
Messages
5,360,767
Members
400,595
Latest member
T_Dubs

Some videos you may like

This Week's Hot Topics

  • VBA (Userform)
    Hi All, I just would like to know why my code isn't working. Here is my VBA code: [CODE=vba]Private Sub OKButton_Click() Dim i As Integer...
  • List box that changes fill color
    Hello, I have gone through so many pages trying to figure this out. I have a 2020 calendar that depending on the day needs to have a certain...
  • Remove duplicates and retain one. Cross-linked cases
    Hi all I ran out of google keywords to use and still couldn't find a reference how to achieve the results of a single count. It would be great if...
  • VBA Copy and Paste With Duplicates
    Hello All, I'm in need of some input. My VBA skills are sub-par at best. I've assembled this code from basic research and it works but is...
  • Macro
    is it possible for a macro to run if the active cell value is different to the value above it
  • IF DATE and TIME
    I currently use this to check if date has passed but i also need to set a time on it too. Is it possible? [CODE=vba]=IF(B:B>TODAY(),"Not...
Top