Rajkumar Bhalodia
New Member
- Joined
- Dec 13, 2020
- Messages
- 1
- Office Version
- 2016
- Platform
- Windows
Hello,
I received Run time error '91' Object variable or with block variable not set while running macro from
Please see code below.
Please resolve this issue. thank you very much in advance.
I received Run time error '91' Object variable or with block variable not set while running macro from
Mail a row or rows to each person in a range (Mail a row or rows to each person in a range)
Please see code below.
Please resolve this issue. thank you very much in advance.
VBA Code:
Sub Macro2()
Dim OutApp As Object
Dim OutMail As Object
Dim rng As Range
Dim Ash As Worksheet
Dim Cws As Worksheet
Dim Rcount As Long
Dim Rnum As Long
Dim FilterRange As Range
Dim FieldNum As Range
On Error GoTo cleanup
Set OutApp = CreateObject("Outlook.Application")
With Aplication
.EnableEvents = False
.ScreenUpdating = False
End With
Set Ash = ActiveSheet
Set FilterRange = Ash.Range("A1:T" & Ash.Rows.Count)
FieldNum = 2 'Filter Column = A
Set Cws = Worksheets.Add
FilterRange.Columns(FieldNum).AdvanceFilter _
Action:=xlFilterCopy, _
CopyToRange:=Cws.Range("A1"), _
CriteriaRange:="", Unique:=True
Rcount = Application.WorksheetFunction.CountA(Cws.Columns(1))
If Rcount >= 2 Then
For Rnum = 2 To Rcount
FilterRange.AutoFilter Field:=FiledNum, _
Criteria1:=Cws.Cells(Rnum, 1).Value
mailAddress = ""
On Error Resume Next
mailAddress = Application.WorksheetFunction. _
VLookup(Cws.Cells(Rnum, 1).Value, _
Worksheets("Mailinfo").Range("A1:B" & _
Worksheets("Mailinfo").Rows.Count), 2, False)
On Error GoTo 0
If mailAddress <> "" Then
With Ash.AutoFilter.Range
On Error Resume Next
Set rng = .SpecialCells(xlCellTypeVisible)
On Error GoTo 0
End With
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.To = mailAddress
.Subject = "COB Reminder"
.HTMLBody = RangetoHTML(rng)
.Display 'Or use Send
End With
On Error GoTo 0
Set OutMail = Nothing
End If
Ash.AutoFilterMode = False
Next Rnum
End If
cleanup:
Set OutApp = Nothing
Application.DisplayAlerts = False
Cws.Delete
Application.DisplayAlerts = True
With Application
.EnableEvents = True
.ScreenUpdating = True
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
TempFile = Environ$("temp") & "/" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"
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
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
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=")
TempWB.Close savechanges:=False
Kill TempFile
Set ts = Nothing
Set fso = Nothing
Set TempWB = Nothing
End Function
End Function
Last edited by a moderator: