Difficulty in identifying min value and sending selected Cells by email. VBA

Question

I’m trying to do a macro where I can identify if there’s a due date in the column L which expires within a month, and if any, launch a msgbox and send an e-mail via Outlook pasting the entire table (I1:O21) in the body of the email.

If there are no salaries with DateDiff < 30, creates a msgBox indicated that there are no payments in that month.

But for some reason there’s a mistake and I can’t identify.

The mistake:

Follows:

Sub Update_payments()

Dim dataMin As Date

Set myRange = Worksheets("Calendário Financeiro").range("L9:L19")
dataMin = Application.WorksheetFunction.Min(myRange)


If DateDiff("d", Now(), dataMinima) < 30 Then
msgbox "Atenção, há pagamentos de seguro dentro de 30 dias, verifique seu e-mail." + vbOKOnly

Dim rng As range

Sheets("Calendário Financeiro").Cells = "I1:O21"
Set rng = Selection.SpecialCells(xlCellTypeVisible)
rng.Copy Sheets("Calendário Financeiro").[A1]
Sheets("Calendário Financeiro").Activate: ActiveSheet.UsedRange.Select
ActiveWorkbook.EnvelopeVisible = True 'False
With ActiveSheet.MailEnvelope
.Introduction = "Olá, segue pagamentos de seguros dentro do mês:"
.Item.To = "[email protected]"
.Item.CC = ""
.Item.Subject = "TESTE Pagamento"
End With

    Else
    msgbox "Não há pagamentos de seguro para serem programados dentro do mês" + vbOKOnly

End If
End Sub

EDIT I ended up closing and opening the spreadsheet and had a different answer in the debugger:

What does that mean?

Answer 1

You need to add the references you will use...

In VBA, go to Tools>References...

I recommend marking the following references:

Visual Basic for Applications
OLE Automation
Microsoft Excel X.XX Object Library The most recent you have
Microsoft Office X.XX Object Library The most recent you have
Microsoft Outlook X.XX Object Library The most recent you have

Answer 2

I was able to make the e-mail with image in the body, saving the selected cells in a temporary folder.

I added the update to Pivotable because the selection is in a table already formatted, with the function GetPivotData in the same spreadsheet.

I just couldn’t include the date check to run the whole Sub only if there is payment scheduled for the month, if anyone can help, follow the Cód:

Follows the Code:

    Sub Atualização_de_Pagamentos()

    Sheets("Calendário Financeiro").Select
    range("A4").Select
    ActiveSheet.PivotTables("Tabela dinâmica1").PivotCache.Refresh

    Dim rng As range

    Dim OutApp As Object
    Dim OutMail As Object

    Set rng = Nothing
    On Error Resume Next
    'Only the visible cells in the selection
    Set rng = Sheets("Calendário Financeiro").range("I1:O20").SpecialCells(xlCellTypeVisible)
    On Error GoTo 0

    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 = "[email protected]"
        .CC = ""
        .BCC = ""
        .Subject = "Teste: Pagamentos de seguros"
        .HTMLBody = RangetoHTML(rng)
        .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 RangetoHTML(rng As range)
' Função de criação de arquivo temporário como imagem para exportar em e-mail
' Changed by Ron de Bruin 28-Oct-2006
' Working in Office 2000-2016
    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"

    '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