locked
Envio automático de e-mail através do Excel RRS feed

  • Pergunta

  • Olá Pessoal,

    Será que vocês conseguem me ajudar ?

    Sou novata em macros e preciso de uma grande ajuda.

    Tenho um projeto importante a ser entregue o quanto antes e falta somente um comando para que eu possa finalizá-lo.

    Tenho uma planilha enorme em Excel com várias guias.

    Tenho uma guia chamada database que possui diversas informações sobre os gastos de cada funcionário com cartões corporativos.

    Na coluna Q desta planilha tenho a relação de e-mails dos funcionários.

    Consegui desenvolver uma macro que gera o extrato de gastos de cada funcionário em novos arquivos. Estes arquivos apresentam o seguinte cabeçalho:

    Exemplo;

    ( Célula a1 )Colaborador / (Célula b1) Rita Hayashi

    (Célula a2)Email / (Célula b2) rita.hayashi@xxxx.com

    Nas células abaixo a macro carrega todas as despesas referentes ao funcionário em questão.

    A grande questão é que estou falando de mais de 200 funcionários, ou seja, 200 extratos diferentes.

    Qual macro devo utilizar para que cada um dos arquivos gerados sejam enviados automaticamente e individualmente para cada funcionário ?

    Vale reforçar que cada arquivo recebe o nome do funcionário a que se refere e que o conteúdo muda de profissional para profissional.

    Abaixo envio o código que gera os extratos:

    Sub gera_relatorio_eduardo()
    Dim nome As String
    Dim item As String
    Dim wb As Workbook
    Dim db As Worksheet
    Dim ws As Worksheet

    Application.ScreenUpdating = False

    Set db = ThisWorkbook.Sheets("Database")
    With db
        rLast = .Cells(.Rows.Count, "A").End(xlUp).Row
    End With
    Set wb = Workbooks.Add

    nome = ""
    soma_total = 0

    For r = 2 To rLast
        nome1 = db.Cells(r, "k")
        item1 = db.Cells(r, "n")
        estabelecimento1 = db.Cells(r, "o")
        Data1 = db.Cells(r, "i")
        transacao = db.Cells(r, "p")
        If transacao > 0 Then
            If nome <> nome1 Then
                If (soma_total > 0) Then
                    ws.Cells(linha + 3, 2) = "TOTAL"
                    ws.Cells(linha + 3, 2).Select
                    Selection.Font.Bold = True
                    Selection.Font.Size = 15
                    ws.Cells(linha + 3, 4) = soma_total
                    ws.Cells(linha + 3, 4).Select
                    Selection.Font.Bold = True
                    Selection.Font.Size = 15
                    With Selection.Font
                        .Color = -16776961
                        .TintAndShade = 0
                    End With
                End If
                linha = 6
                linha_item = linha
                soma_total = 0
                soma_item = 0
                nome = nome1
                ThisWorkbook.Sheets("Modelo_Eduardo").Copy Before:=wb.Sheets(1)
                Set ws = wb.Sheets(1)
                'Renomeia a nova Planilha para, por exemplo, o nome de uma
                'pessoa da Planilha Lista:
                ws.Name = nome
                ws.Cells(1, 2) = nome
                ws.Cells(2, 2) = db.Cells(r, "f")
                item = item1
                estabelecimento = estabelecimento1
                data = Data1
                ws.Cells(linha, 2) = item
                ws.Cells(linha + 1, 2) = estabelecimento
                ws.Cells(linha + 1, 1) = data
                soma_total = transacao
                soma_item = transacao
                soma = transacao
                ws.Cells(linha_item, 4) = soma_item
                ws.Cells(linha + 1, 4) = soma
                ws.Rows(linha + 1).Select
                Selection.Font.Size = 9
                linha = linha + 1
            ElseIf (nome = nome1 And item = item1 And estabelecimento = estabelecimento1 And data = Data1) Then
                soma_total = soma_total + transacao
                soma_item = soma_item + transacao
                soma = soma + transacao
                ws.Cells(linha_item, 4) = soma_item
                ws.Cells(linha, 4) = soma
                ws.Rows(linha).Select
                Selection.Font.Size = 9
            ElseIf (nome = nome1 And item = item1 And estabelecimento <> estabelecimento1) Or (nome = nome1 And item = item1 And estabelecimento = estabelecimento1 And data <> Data1) Then
                linha = linha + 1
                soma_total = soma_total + transacao
                soma_item = soma_item + transacao
                estabelecimento = estabelecimento1
                data = Data1
                ws.Cells(linha_item, 4) = soma_item
                ws.Cells(linha, 2) = estabelecimento
                ws.Cells(linha, 1) = data
                ws.Rows(linha).Select
                Selection.Font.Size = 9
                soma = transacao
                ws.Cells(linha, 4) = soma
            ElseIf (nome = nome1 And item <> item1) Then
                linha = linha + 1
                soma_total = soma_total + transacao
                soma_item = transacao
                linha_item = linha
                ws.Cells(linha_item, 4) = soma_item
                item = item1
                estabelecimento = estabelecimento1
                data = Data1
                ws.Cells(linha, 2) = item
                ws.Cells(linha + 1, 2) = estabelecimento
                ws.Cells(linha + 1, 1) = data
                soma = transacao
                ws.Cells(linha + 1, 4) = soma
                ws.Rows(linha + 1).Select
                Selection.Font.Size = 9
                linha = linha + 1
            End If
        End If
        If (r = rLast And soma_total > 0) Then
            ws.Cells(linha + 3, 2) = "TOTAL"
            ws.Cells(linha + 3, 2).Select
            Selection.Font.Bold = True
            Selection.Font.Size = 15
            ws.Cells(linha + 3, 4) = soma_total
            ws.Cells(linha + 3, 4).Select
            Selection.Font.Bold = True
            Selection.Font.Size = 15
            With Selection.Font
                .Color = -16776961
                .TintAndShade = 0
            End With
        End If
    Next r


    Application.ScreenUpdating = True

    End Sub

    A grande dúvida agora é realmente como enviar automaticamente as planilhas para cada funcionário.

    Aguardo um retorno.

    MUITO OBRIGADA!

    Atc,

    Rita Hayashi

    quinta-feira, 24 de março de 2011 22:13

Todas as Respostas