0

Estou tentando fazer uma macro em que identifique se há uma data de vencimento na coluna L que vence dentro de um mês, e se houver, lançar um msgbox e envie um e-mail via Outlook colando toda a tabela (I1:O21) no corpo do e-mail.

Caso não haja vencimentos com DateDiff < 30, cria um msgBox indicado que não há pagamentos nesse mês.

Mas por algum motivo há um erro e não consigo identificar.

O erro:

inserir a descrição da imagem aqui

Segue cód:

Sub Atualizar_pagamentos()

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 Acabei fechando e abrindo a planilha e tive uma resposta diferente no depurador: inserir a descrição da imagem aqui

O que isso significa?

7
  • Qual é o erro que exibe?
    – Denied
    Commented 11/10/2019 às 17:02
  • adicionei a imagem com o erro.
    – Amadeu
    Commented 11/10/2019 às 17:43
  • Você declara a variável depois de utilizá-la. Coloque Dim dataMin As Date antes de dataMin = Application.WorksheetFunction.Min(myRange). A utilização de Option Explicit evita este tipo de erro, pois você precisaria declarar todas as variáveis. Commented 11/10/2019 às 19:52
  • Coloquei na seguinte ordem: `` Dim dataMin As Date Set myRange = Worksheets("Calendário Financeiro").range("L9:L19") dataMin = Application.WorksheetFunction.Min(myRange)
    – Amadeu
    Commented 11/10/2019 às 20:00
  • O erro mudou para "Erro Tempo de execução '6' - Estouro
    – Amadeu
    Commented 11/10/2019 às 20:01

2 Respostas 2

0

Você precisa adcionar as referências que irá utilizar...

No VBA, vá em Ferramentas>Referências...

Recomendo marcar as seguintes referências:

Visual Basic for Applications
OLE Automation
Microsoft Excel X.XX Object Library A mais recente que tiver
Microsoft Office X.XX Object Library A mais recente que tiver
Microsoft Outlook X.XX Object Library A mais recente que tiver

4
  • Já estão todas essas marcadas, junto com o Microsoft Forms
    – Amadeu
    Commented 11/10/2019 às 19:15
  • Ah, por você também utilizar e-mail faltou também a do Microsoft Outlook XX.X Object Library Commented 11/10/2019 às 19:18
  • Não estava selecionado, mas acredito que não seja esse o problema. Já selecionei e não rodou a macro. E já escrevi outros códigos de envio de e-mail pelo outlook mesmo sem estar marcado nas referências.
    – Amadeu
    Commented 11/10/2019 às 19:24
  • Estranho... O erro que está dando é relacionado a uma falta de referência. Algumas vezes pode ser outro módulo, ou também pode estar com algum problema o VBA Commented 11/10/2019 às 20:01
0

Consegui fazer o e-mail com imagem no corpo, salvando as células selecionadas em uma pasta temporária.

Adicionei a atualização da PivoTable pois a seleção está em uma tabela já formatada, com a função GetPivotData na planilha mesmo.

Só não consegui incluir a verificação de data, pra rodar toda a Sub somente se houver pagamento programado para o mês, se alguém puder ajudar, segue o cód:

Segue o Cód:

    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

Você deve fazer log-in para responder a esta pergunta.

Esta não é a resposta que você está procurando? Pesquise outras perguntas com a tag .