VBA Compile error - Trying to send an email using VBA/Excel

willow1985 · Oct 24, 2023

Hi Everyone,

I was trying to have a Macro send an automatic email with a table, however I am getting a Compile error: Wrong number of arguments of invalid property assignment in the Function.

I got this Function code online and have been using it for multiple sheets just like this one but for some reason I am now getting this error.

The only difference is the range I want in an email is a table this time around (Table: WE) and not just a basic range.

Would this be the issue and if so what would I have to change?

Error is in the Function on line: TempFile = Environ$("temp") & "\" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"

Thank you to anyone that can help!

VBA Code:

Sub Warranty_Email()

'

' Warranty_Email Macro

'

msg = "Do you wish to send out a Warranty Notification Email to all applicable Inspectors?"

ans = MsgBox(msg, vbYesNo)



Select Case ans



Case vbYes

Application.ScreenUpdating = False

Workbooks("Customer Concern - Warranty Request Log.xlsm").Activate

Worksheets("Warranty Email").Visible = True

Sheets("Warranty Email").Select

ActiveSheet.ListObjects("WE").Resize Range("$A$1:$R$2")

Range("A3:R100").Select

Selection.ClearContents



Sheets("CC Database").Select

Worksheets("CC Database").Unprotect Password:="SADIE"

ActiveCell.Select

For Each lo In ActiveSheet.ListObjects

lo.AutoFilter.ShowAllData

Next lo

If (ActiveSheet.AutoFilterMode And ActiveSheet.FilterMode) Or ActiveSheet.FilterMode Then

ActiveSheet.ShowAllData

End If

Cells.EntireColumn.Hidden = False

ActiveSheet.ListObjects("Table1").Range.AutoFilter Field:=22, Criteria1:= _

"Open"

If ActiveSheet.ListObjects("Table1").Range.Columns(1).SpecialCells(xlCellTypeVisible).Count = 1 Then

ActiveSheet.ShowAllData

MsgBox "No Open Warranties"

GoTo NoWar

End If

ActiveSheet.ListObjects("Table1").Range.AutoFilter Field:=8, Criteria1:= _

"AS"

If ActiveSheet.ListObjects("Table1").Range.Columns(1).SpecialCells(xlCellTypeVisible).Count = 1 Then

ActiveSheet.ShowAllData

MsgBox "No Open AS Warranties"

GoTo NoWar

End If

ActiveSheet.ListObjects("Table1").Range.AutoFilter Field:=22, Criteria1:= _

"Open"

If ActiveSheet.ListObjects("Table1").Range.Columns(1).SpecialCells(xlCellTypeVisible).Count = 1 Then

ActiveSheet.ShowAllData

MsgBox "No Open AS Warranties"

GoTo NoWar

End If

ActiveSheet.ListObjects("Table1").Range.AutoFilter Field:=20, Criteria1:= _

"="

If ActiveSheet.ListObjects("Table1").Range.Columns(1).SpecialCells(xlCellTypeVisible).Count = 1 Then

GoTo NextF

End If

NextF:

ActiveSheet.ListObjects("Table1").Range.AutoFilter Field:=18, Criteria1:= _

"="

If ActiveSheet.ListObjects("Table1").Range.Columns(1).SpecialCells(xlCellTypeVisible).Count = 1 Then

GoTo NextF2

End If

NextF2:



ActiveSheet.ListObjects("Table1").Range.AutoFilter Field:=27, Criteria1:= _

"="

If ActiveSheet.ListObjects("Table1").Range.Columns(1).SpecialCells(xlCellTypeVisible).Count = 1 Then

GoTo NextF3

End If

NextF3:



ActiveSheet.ListObjects("Table1").Range.AutoFilter Field:=28, Criteria1:= _

"="

If ActiveSheet.ListObjects("Table1").Range.Columns(1).SpecialCells(xlCellTypeVisible).Count = 1 Then

GoTo NextF4

End If

NextF4:

ActiveSheet.ListObjects("Table1").DataBodyRange.Columns("A:F").Select

Selection.SpecialCells(xlCellTypeVisible).Copy

Sheets("Warranty Email").Select

Range("A2").Select

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

:=False, Transpose:=False

Application.CutCopyMode = False

Sheets("CC Database").Select

ActiveSheet.ListObjects("Table1").DataBodyRange.Columns("I").Select

Selection.SpecialCells(xlCellTypeVisible).Copy

Sheets("Warranty Email").Select

Range("G2").Select

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

:=False, Transpose:=False

Application.CutCopyMode = False

Sheets("CC Database").Select

ActiveSheet.ListObjects("Table1").DataBodyRange.Columns("M:Q").Select

Selection.SpecialCells(xlCellTypeVisible).Copy

Sheets("Warranty Email").Select

Range("H2").Select

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

:=False, Transpose:=False

Application.CutCopyMode = False

Sheets("CC Database").Select

ActiveSheet.ListObjects("Table1").DataBodyRange.Columns("R:T").Select

Selection.SpecialCells(xlCellTypeVisible).Copy

Sheets("Warranty Email").Select

Range("M2").Select

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

:=False, Transpose:=False

Application.CutCopyMode = False

Sheets("CC Database").Select

ActiveSheet.ListObjects("Table1").DataBodyRange.Columns("AA:AB").Select

Selection.SpecialCells(xlCellTypeVisible).Copy

Sheets("Warranty Email").Select

Range("P2").Select

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

:=False, Transpose:=False

Application.CutCopyMode = False



Call sendmail

Application.ScreenUpdating = True

Worksheets("Warranty Email").Visible = False

NoWar:

Sheets("CC Database").Select

If (ActiveSheet.AutoFilterMode And ActiveSheet.FilterMode) Or ActiveSheet.FilterMode Then

ActiveSheet.ShowAllData

End If



Case vbNo

GoTo Quit:

End Select



Quit:

Worksheets("CC Database").Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _

, AllowFiltering:=True, Password:="SADIE"

End Sub





Sub sendmail()

Dim OutlookApp As Object, MItem As Object, cad As String

Dim i As Long, Sh As Worksheet, rng As Range, lr As Long



Set Sh = Sheets("Warranty Email")

lr = Sh.Range("A" & Rows.Count).End(xlUp).Row

Set rng = Sh.Range("A1:R" & lr)

For i = 2 To lr

cad = cad & Sh.Range("V" & i).Value & "; "

Next

Set OutlookApp = CreateObject("Outlook.Application")

Set MItem = OutlookApp.CreateItem(0)

With MItem

.To = cad

.Subject = Sh.Range("W1").Value

.htmlBody = Sh.Range("W2").Value & RangetoHTML(rng) & "Thank you"



.Display

.Send

End With

End Sub



Function RangetoHTML(rng As Range)



Dim fso As Object

Dim ts As Object

Dim TempFile As String

Dim TempWB As Workbook


'ERROR IS ON THE LINE BELOW AT FORMAT[ATTACH type="full"]100918[/ATTACH]
TempFile = Environ$("temp") & "\" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"



'Copy the range and create a new workbook to past the data in

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



'Publish the sheet to a htm file

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



'Read all data from the htm file into RangetoHTML

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=")



'Close TempWB

TempWB.Close Savechanges:=False



'Delete the htm file we used in this function

Kill TempFile



Set ts = Nothing

Set fso = Nothing

Set TempWB = Nothing

End Function

Warranty Log.xlsm

A

B

C

D

E

F

G

H

I

J

K

L

M

N

O

P

Q

R

S

T

U

V

W

1

Customer Concern Number

Date

Latest W/O #

Previous W/O #(s)

PO#

Model Type

Customer Name

P/N

S/N

Description

Discrepancy

Total number of Parts

Area Issued to

Verification completed Y/N

Warranty Granted Y/N

Warranty Cost

Work done in Good Faith Y/N

Additional Notes

Inspector List:

me@email.com

Pending Warranty Inspections/Required Updates

2

CC1234

28-Aug-19

69881

test

Customer

test

Error

5

N

The below listed Warranties require inspection and/or updates. Please complete the items in yellow and email back to the QA Dept.

Warranty Email

Logit · Oct 24, 2023

VBA Code:

Option Explicit

Sub send_email_via_outlook()

' Tools - Refrence - Microsoft Outlook
Dim olApp As New Outlook.Application
Dim olMail As MailItem

Set olMail = olApp.CreateItem(olMailItem)
    
    With olMail
        .To = "myemail@yahoo.com"
        .CC = ""
        .Subject = "Send Range as table in outlook"  '<br> used to insert a line ( press enter)
        .HTMLBody = "Hi Richard, <br> <br>" & "I have the following purchase request(s) for you, regarding the production of " & Sheet1.Range("G2").Value & ".<br><br> " & _
                    create_table(Sheets("Sheet1").Range("A1").CurrentRegion) & _
                    "</Table><br> <br>If you have any questions about my order request, please contact me on 079-44251826. <br> <br>" & _
                    "Thank you in advance,<br> <br>" & _
                    "Greetings Max<br><br>"
        .Display
        '.Send
    End With


End Sub

Function create_table(rng As Range) As String

Dim mbody As String
Dim mbody1  As String
Dim i As Long
Dim j As Long

' for html color codes list visit http://www.w3schools.com/html/html_colornames.asp

mbody = "<TABLE width=""65%"" Border=""1"", Cellspacing=""0""><TR>" ' configure the table

'create Header row
For i = 1 To rng.Columns.Count
    mbody = mbody & "<TD width=""100"", Bgcolor=""#A52A2A"", Align=""Center""><Font Color=#FFFFFF><b><p style=""font-size:18px"">" & rng.Cells(1, i).Value & "&nbsp;</p></Font></TD>"
Next

' add data to the table
For i = 2 To rng.Rows.Count
    mbody = mbody & "<TR>"
    mbody1 = ""
    For j = 1 To rng.Columns.Count
    mbody1 = mbody1 & "<TD><center>" & rng.Cells(i, j).Value & "</TD>"
    Next
    mbody = mbody & mbody1 & "</TR>"
Next

create_table = mbody
End Function

Download workbook : Internxt Drive – Private & Secure Cloud Storage

willow1985 · Oct 25, 2023

Logit said:

VBA Code:

Option Explicit

Sub send_email_via_outlook()

' Tools - Refrence - Microsoft Outlook
Dim olApp As New Outlook.Application
Dim olMail As MailItem

Set olMail = olApp.CreateItem(olMailItem)
   
    With olMail
        .To = "myemail@yahoo.com"
        .CC = ""
        .Subject = "Send Range as table in outlook"  '<br> used to insert a line ( press enter)
        .HTMLBody = "Hi Richard, <br> <br>" & "I have the following purchase request(s) for you, regarding the production of " & Sheet1.Range("G2").Value & ".<br><br> " & _
                    create_table(Sheets("Sheet1").Range("A1").CurrentRegion) & _
                    "</Table><br> <br>If you have any questions about my order request, please contact me on 079-44251826. <br> <br>" & _
                    "Thank you in advance,<br> <br>" & _
                    "Greetings Max<br><br>"
        .Display
        '.Send
    End With


End Sub

Function create_table(rng As Range) As String

Dim mbody As String
Dim mbody1  As String
Dim i As Long
Dim j As Long

' for html color codes list visit http://www.w3schools.com/html/html_colornames.asp

mbody = "<TABLE width=""65%"" Border=""1"", Cellspacing=""0""><TR>" ' configure the table

'create Header row
For i = 1 To rng.Columns.Count
    mbody = mbody & "<TD width=""100"", Bgcolor=""#A52A2A"", Align=""Center""><Font Color=#FFFFFF><b><p style=""font-size:18px"">" & rng.Cells(1, i).Value & "&nbsp;</p></Font></TD>"
Next

' add data to the table
For i = 2 To rng.Rows.Count
    mbody = mbody & "<TR>"
    mbody1 = ""
    For j = 1 To rng.Columns.Count
    mbody1 = mbody1 & "<TD><center>" & rng.Cells(i, j).Value & "</TD>"
    Next
    mbody = mbody & mbody1 & "</TR>"
Next

create_table = mbody
End Function

Download workbook : Internxt Drive – Private & Secure Cloud Storage

I do not know how to apply your code to my current set up.
for the .To = I cannot enter 1 email address. It needs to reference multiple addresses that are in a list starting at V1 on sheets("Warranty Email")
Second, the Subject needs to reference W1 and the .HTMLBody. needs to reference W2 to start and then the entire table named "WE".

I have tried modifying your code but I can't seem to apply it to my sheet/what I require.

Could you help apply your code to my sheet?

Thank you

willow1985 · Oct 25, 2023

I figured out the problem with my original code. apparently it was the word "Format". I changed it to VBA.Format and everything works now.

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

to

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

All is good

Logit · Oct 25, 2023

Glad to hear it.

willow1985 · Oct 25, 2023

Logit said:
Glad to hear it.

Thank you for your help

gorgkhan · Dec 4, 2023

willow1985 said:
The only difference is the range I want in an email is a table this time around (Table: WE) and not just a basic range.

so Why don't you convert the Table to range?

VBA Compile error - Trying to send an email using VBA/Excel

willow1985

Well-known Member

Attachments

Excel Facts

Logit

Well-known Member

willow1985

Well-known Member

willow1985

Well-known Member

Logit

Well-known Member

willow1985

Well-known Member

gorgkhan

New Member

Similar threads

Forum statistics

Share this page

VBA Compile error - Trying to send an email using VBA/Excel

willow1985

Well-known Member

Attachments

Excel Facts

Logit

Well-known Member

willow1985

Well-known Member

willow1985

Well-known Member

Logit

Well-known Member

willow1985

Well-known Member

gorgkhan

New Member

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock