Ir ao conteúdo
  • Cadastre-se

Enviar diversos arquivos para pessoas diferentes


Ir à solução Resolvido por Basole,

Posts recomendados

  • Solução

Como você nao passou > detalhes, segue um exemplo abaixo. Crie um modulo e cole a macro, e na plan1 crie tbem. uma tabela (com os dados das pessoas que vai enviar e respect. nome do arquivo), nas colunas:

[a ] c/ o nome [Nome do Arquivo]; c/ o nome [Departamento](opcional); [C] c/ o nome [1º Nome]; [d] c/ o nome [sobrenome]; [E] c/ o nome [Emails];por ultimo: [ J ] c/ o nome Path (pasta onde esta o arquivo ex: C:\Users\Admin\Desktop) e preencha os dados de cada coluna. Na coluna [A] insira o nome do arquivo sem sua extensão.

 

Sub Envia_Email_CAnexo()
' fonte: http://www.rondebruin.nl/win/s1/div/mail1.htm
    Dim OutApp As Object
    Dim OutMail As Object
    Dim ws As Worksheet: Set ws = Sheets("plan1")
    Dim enviad As String
    enviad = 0
    'Path do anexo ao email a ser enviado
    Set Rng = ws.Range(Range("J2"), ws.Range("J" & Rows.Count).End(xlUp))
    For Each cell In Rng
        Rw = cell.Row
        Path = cell.Value
        If Path <> "" Then
            'Obtem a informacao do path
            Dte = Right(Path, Len(Path) - InStrRev(Path, "\"))
            'obtem o  nome do arquivo na (Coluna A)
            strNomeArq = cell.Offset(0, -9).Value
            ' endereco de Email
            ToNome = cell.Offset(0, -5).Value
            ccTo = RecpList
            'Obtem o nome
            FirstNme = cell.Offset(0, -7).Value
            Surname = cell.Offset(0, -6).Value
            'faz loop através do caminho dos arquivos ver se existe
            ClientFile = Dir(Path & "\*.*")
            Do While ClientFile <> ""
                If InStr(ClientFile, strNomeArq) > 0 Then
                    AttachFile = Path & "\" & ClientFile
                    MailBody = "Prezado " & FirstNme & vbNewLine & vbNewLine _
                               & "Segue em anexo uma cópia do seu relatório de analise de custo de  " & Dte _
                               & vbNewLine & vbNewLine _
                               & "Nome do Arquivo: " & cell.Offset(0, -9).Value _
                               & vbNewLine & _
                               "Departamento: " & cell.Offset(0, -8).Value _
                               & vbNewLine & _
                               "Gerencia do Centro de Custo: " & FirstNme & " " & Surname _
                               & vbNewLine & _
                               "Saudaçoes" & _
                               Signature    '(asinatura)
                    Set OutApp = CreateObject("Outlook.Application")
                    Set OutMail = OutApp.CreateItem(o)
                    With OutMail
                        .Subject = "Relatório Centro de custo de - " & Dte
                        .To = ToNome
                        .cc = ccTo
                        .Body = MailBody
                        .Attachments.Add (AttachFile)
                        '.Display
                        .Send
                        enviad = enviad + 1
                    End With
                    Set OutMail = Nothing
                    Set OutApp = Nothing
                    RecpList = ""
                End If
                ClientFile = Dir
            Loop
        End If
    Next
    If enviad = 0 Then
    MsgBox "Nenhum email enviado", 64, "AVISO"
    Else
    MsgBox enviad & " enviados da sua lista de emails!", 0, "SUCESSO"
    End If
End Sub

  • Curtir 2
Link para o comentário
Compartilhar em outros sites

  • 3 anos depois...

Crie uma conta ou entre para comentar

Você precisa ser um usuário para fazer um comentário

Criar uma conta

Crie uma nova conta em nossa comunidade. É fácil!

Crie uma nova conta

Entrar

Já tem uma conta? Faça o login.

Entrar agora

Sobre o Clube do Hardware

No ar desde 1996, o Clube do Hardware é uma das maiores, mais antigas e mais respeitadas comunidades sobre tecnologia do Brasil. Leia mais

Direitos autorais

Não permitimos a cópia ou reprodução do conteúdo do nosso site, fórum, newsletters e redes sociais, mesmo citando-se a fonte. Leia mais

×
×
  • Criar novo...