none
Erro de macro quando envia e-mail autmático RRS feed

  • Pergunta

  • Bom  dia!

    Criei uma planilha e inseri uma macro cuja ideia veio de um "internauta". A planilha consiste em um mapa de controle de RNC's. Então tem a data  de abertura com seu respectivo assunto, e junto a data de abertura é enviado uma RNC por e-mail para o fornecedor não conforme  e o mesmo tem 5 dias para responder  e quando ultrapassa o 5 dia uma macro envia um e-mail automático. Porém não está enviando automático, somente quando mudo o código  de Send para display que a macro roda corretamente, quando deixo em Send, aparece um erro de execução n. 287... 

    O código macro é:

    Private Sub Worksheet_Change(ByVal Target As Range)
        Dim OutApp As Object
        Dim OutMail As Object
        Dim texto As String

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

        linha = ActiveCell.Row - 1
        If Target.Address = "$I$" & linha Then

            If Plan1.Cells(linha, 9) = "Não" Then
                texto = "Prezado(a) " & Plan1.Cells(linha, 1) & "," & vbCrLf & vbCrLf & _
                        "O Relatório de Análise de Causa Raiz  " & Plan1.Cells(linha, 2) & " aberto em " & _
                         Plan1.Cells(linha, 3) & " ainda não foi respondido." & vbCrLf & _
                        " Veja informações abaixo:" & vbCrLf & _
                        " Respondeu no prazo de 5 dias: " & Plan1.Cells(linha, 9) & vbCrLf & _
                        " Cód.do item: " & Plan1.Cells(linha, 6) & vbCrLf & vbCrLf & _
                        " Não conformidade: " & Plan1.Cells(linha, 7) & vbCrLf & vbCrLf & _
                        " Necessário o reenvio urgente do relatório: " & Plan1.Cells(linha, 2) & vbCrLf & vbCrLf & _
                        "Atenciosamente," & vbCrLf & vbCrLf & _
                        "Rodrigo Oliveira" & vbCrLf & _
                        "Controle Qualidade Inbrasp"
            End If

            With OutMail
                .To = Plan1.Cells(linha, 1)
                .CC = ""
                .BCC = ""
                .Subject = "Relatório de Análise de Causa Raiz"
                .Body = texto
                .Display 'Utilize Send para enviar o email sem abrir o Outlook
            End With
            On Error GoTo 0

            Set OutMail = Nothing
            Set OutApp = Nothing
        End If
    End Sub

    sábado, 12 de abril de 2014 20:56