Fóruns
Microsoft Excel - 2...
2024 - VBA & Macros
Chamar e-mail anexa...
 
Notifications
Clear all

Chamar e-mail anexando nova planilha.

 
2024 - VBA & Macros
Post Recente por jeffergar 13 anos atrás
4 Posts
2 Usuários
0 Reactions
1,043 Visualizações
RSS
Fernando Fernandes
 Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
Topic starter
 

E ai galera, Blz...

Atualmente tenho um codigo informado abaixo (gentilmente feito pelo nosso colega 'Mauro Coutinho'), que filtra o conteúdo de uma determinada planilha (vamos denomina-la de "Dados") e joga o resultado deste filtro em um novo arquivo xls (o nome deste novo arquivo pramim é indiferente), e já chama a tela do Outlook (no meu caso Microsoft Outlook) ja anexando este novo arquivo xls neste e-mail. (excelente.!)

Porém, preciso de uma melhoria neste.

Preciso que, quando já abrir esta janela do Outlook, além de trazer o novo arquivo já anexado (como é feito hoje) eu quero que ele já traga preenchido o 'E-mail do Destinatário' e o 'Assunto'. Obs: estas informações de 'e-mail do destinatario' será o conteúdo da celula "B2" e o 'Assunto' será o conteúdo da celula "B1" da planilha Base "Dados" onde estão as informações que são filtradas.

Segue o Código que hoje está rodando perfeitamente.

'Sub FiltroNewWkB()
Dim wsOrigem As Worksheet

Set wsOrigem = Sheets("Dados")
           
'Cria uma nova Pasta
Set Wkb = Workbooks.Add
    'Nomeia a Aba
    With ActiveSheet
        .Name = "filtrados"
        .Range("A1").Select
    End With

        'Aplica o Filtro Avançado e Copia para a ABA "filtrados"
        'do novo WB
        'O CRITERIO ESTÁ NESTE ENDEREÇO : wsOrigem.Range("D1:D2")
        wsOrigem.Range("Database") _
            .AdvancedFilter Action:=xlFilterCopy, _
            CriteriaRange:=wsOrigem.Range("D1:D2"), _
            CopyToRange:=ActiveSheet.Range("A1"), Unique:=False
            
            Range("A1").Activate
                
            'Ajusta a largura das colunas
            ActiveSheet.Columns("A:R").AutoFit
            
            ActiveWorkbook.SendMail Recipients:=Wait
            'ActiveWorkbook.SendMail Recipients:=Range("B2")
                        
End Sub

Abraço a todos.!

At;
Dann.

Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel

 
Postado : 16/12/2011 7:02 am
Fernando Fernandes
 Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
Topic starter
 

Olá danilobtos!

Sei que já tem uns dias que vc postou, mas deixo uma sugestão.

Não sei de macros o suficiente para te ajudar, mas, há cerca de 1 semana precisei fazer quase exatamente o que você está querendo, com a diferença de que eu queria imprimir uma planilha em PDF.

Foi então que eu encontrei este anexo que te encaminho na net. O único empecilho é que está em inglês. De qualquer forma, esse tutorial (muito completo, por sinal) resolveu absolutamente 100% do meu problema; tive apenas que fazer algumas modificações do tipo: diretório onde salvar os arquivos, os e-mail que queria que recebessem a mensagem, título do e-mail, corpo do e-mail, etc.

Espero que seja útil.

Abraços!

Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel

 
Postado : 06/01/2012 9:23 am
Fernando Fernandes
 Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
Topic starter
 

Bruno, Muitíssimo Obrigado, com certeza será muito util.!

;)

Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel

 
Postado : 06/01/2012 9:54 am
 jeffergar
(@jeffergar)
Posts: 15
Active Member
 

Olá danilobtos!

Não sei se conseguiu resolver o seu problema.

Tenho um exemplo em anexo que pode ajudá-lo.

Segue código e planilha anexada:

Sub Envia_email()



'Application.DisplayAlerts = False

Set myOlApp = CreateObject("Outlook.Application")
Set MyItem = myOlApp.CreateItem(olMailItem)
Set myAttachments = MyItem.Attachments
Set Planilha = Sheets(1) 'aqui define que o objeto é a primeira planilha na ordem,
                            'portanto, a sua que contêm os dados deve fazer o mesmo,
                            'ou alterar o código

    


On Error Resume Next


Sheets("BASE_EMAIL").Select    'coloque o nome da sua planilha que contêm os dados
Range("A4").Select

EMAIL1 = ActiveCell.Offset(0, 4).Value 'se for o caso, não se esqueça de trocar a posição da coluna na qual está o email1
EMAIL2 = ActiveCell.Offset(0, 5).Value ' o mesmo para as demais variáveis abaixo
DESTINATARIO = ActiveCell.Offset(0, 7).Value
PASTA = ActiveCell.Offset(0, 8).Value


Do While ActiveCell.Value <> "FIM"
        
        
        
        Do While ActiveCell.Value = ""  'verifica se a coluna A está desmarcada (no exemplo uso o 'X') e salta para o próximo registro
            ActiveCell.Offset(1, 0).Select
        Loop
        
        If ActiveCell.Value = "FIM" Then
            MsgBox "TODOS OS EMAILS FORAM ENVIADOS COM SUCESSO"
            Exit Sub
        End If
        
        
        EMAIL1 = ActiveCell.Offset(0, 4).Value
        EMAIL2 = ActiveCell.Offset(0, 5).Value
        DESTINATARIO = ActiveCell.Offset(0, 7).Value
        PASTA = ActiveCell.Offset(0, 8).Value
        DPS = Date

        If EMAIL1 = "" Then ' aqui você pode alterar o código e colocar condições para enviar ou para o email1, ou 2, ou os dois
        
                MsgBox "Não existe e-mail1"
                conteudo = "Não existe e-mail1"
                With MyItem
                    .to = EMAIL2
                    .Subject = "Envio de e-mail2" & DPS
                    .Body = conteudo
                    .Send ' caso queira pode colar o código abaixo para enviar o arquivo ao e-mail2
                End With
                
        Else
        
                CAMINHO = "C:TEMPEXEMPLO" & PASTA & "" & DESTINATARIO & ".xls"
                
            
                Workbooks.Open Filename:= _
                CAMINHO

                ASS = "ASSUNTO DO EMAIL" & DPS
                ActiveWorkbook.SendMail Recipients:=EMAIL1, Subject:=ASS
                ActiveWorkbook.Close
          
                conteudo = "Você recebeu um arquivo no e-mail" & EMAIL1
                With MyItem
                    .to = EMAIL2
                    .Subject = "Assunto da mensagem" & DPS
                    .Body = conteudo
                    .Send
                End With
                
                
        End If
        
        
        
        
        
    Set myOlApp = CreateObject("Outlook.Application")
    Set MyItem = myOlApp.CreateItem(olMailItem)
    Set myAttachments = MyItem.Attachments
    Set Planilha = Sheets(1)
    ActiveCell.Offset(1, 0).Select
    
Loop

End Sub

Vê se o exemplo serve e responde pra gente.

T+!!!

 
Postado : 13/01/2012 5:13 pm
Forum Jump:
  Tópico Anterior
Próximo Tópico