locked
Envio automático de e-mail para participantes de plano de ação RRS feed

  • Pergunta

  • Olá

    Sou responsável pelos planos de ação das não-conformidades da empresa. Diariamente verifico em uma planilha eletrônica do excel as pendências e envio e-mails aos responsáveis cobrando-os as suas ações. Atualmente existem muitos itens nos planos e gasto muito tempo enviando e-mails.
    Esta planilha possui 4 colunas. A primeira com a descrição da ação, a segunda com o nome do responsável, a terceira com o prazo para o comprimento da açào, e a quarta com a data de conclusão da ação.
    Presciso automatizar este processo da seguinte forma. Diariamente enviar e-mails para os respnosáveis das ações, informando a descrição da ação, o prazo para o cumprimento e se a realização esta atrazada ou não.
    Caso alguem possa me ajudar ficarei muito grato.
    sexta-feira, 14 de agosto de 2009 13:02

Todas as Respostas

  • Bom dia Edivan.

    Você não pode mandar a planilha anexada para todos os responsáveis pela execução do plano de ação.??

    Se puder, você pode utilizar esse código.

    Sub Mail_Outlook_Express()
        Dim Recipient As String, Subj As String, HLink As String
        Dim Recipientcc As String, Recipientbcc As String
        Dim msg As String
        Dim Arq As String
        

    'Aqui coloca a célula onde deve estar o nome do arquivo à ser enviado
    Arq = Sheets("Plan1").Range("A1").Text

    'Aqui cria o arquivo temporário na unidade C:\ (ou outro caminho de sua preferencia)
    ThisWorkbook.SaveCopyAs Filename:="C:\" & Arq & ".xls"
            
        Recipient = "fulino@aol.com.br;fulanodetal@hotmail.com"
        Recipientcc = "ciclanodetal@hotmail.com;beltranodetal@hotmail.com"
        Recipientbcc = ""
        Subj = "Pedido referente a semana 10"
        msg = "Affonso, bom dia!!!" & vbNewLine & vbNewLine & _
              "Favor enviar para (valor de A1 ou o dia seguinte) o que segue abaixo:"
              
        msg = WorksheetFunction.Substitute(msg, vbNewLine, "%0D%0A")
        HLink = "mailto:" & Recipient & "?" & "cc=" & Recipientcc _
              & "&" & "bcc=" & Recipientbcc & "&"
        HLink = HLink & "subject=" & Subj & "&"
        HLink = HLink & "body=" & msg
        ThisWorkbook.FollowHyperlink (HLink)

    'Aqui anexa o arquivo e envia o email
    With Application
        .Wait (Now + TimeValue("0:00:01"))
        .SendKeys "%i", Wait = True
        .SendKeys "~", Wait = True
        .SendKeys "C:\" & Arq & ".xls", Wait = True
        .SendKeys "~", Wait = True 
        .SendKeys "%s", Wait = True
    End With
        
    'Aqui apaga o arquivo temporário
    Application.Wait (Now + TimeValue("0:00:05"))
    Kill "C:\" & Arq & ".xls"

    End Sub

    Mais para isso, você tem que estar utilizando o Outlook express.

    ...
    sexta-feira, 14 de agosto de 2009 13:47