Notifications
Clear all

Macro enviar Email PDF

25 Posts
3 Usuários
0 Reactions
3,685 Visualizações
(@fazerbem)
Posts: 697
Honorable Member
Topic starter
 

Achei esta Macro na internet e gostaria de fazer algumas modificacoes.

Eu quero que ao inves de enviar por email toda a minha planilha, a macro crie um PD,F apenas da planilha ao qual vou colocar o Botao de Macro. Nao preciso que o arquivo seja salva , pode ficar numa pasta temporaria e assim que enviar o mesmo se deleta.

Poderia alguem aqui fazer esta modificacao e me passar ?

Grato mais uma vez.

Andre

Sub eMailActiveWorkbook()

Dim OL As Object
Dim EmailItem As Object
Dim Wb As Workbook

Application.ScreenUpdating = False
Set OL = CreateObject("Outlook.Application")
Set EmailItem = OL.CreateItem(olMailItem)
Set Wb = ActiveWorkbook
Wb.Save
With EmailItem
.Subject = "Esboço Pedido Gauer do Brasil"
.Body = "Segue anexo seu Pedido para Aprovação." & vbCrLf & _
"" & vbCrLf & _
"Obrigado!"
.To = "[email protected]"
.CC = "[email protected]"
.Importance = olImportanceNormal
.Attachments.Add Wb.FullName
.Send

MsgBox "RELATÓRIO ENVIADO COM SUCESSO!", vbInformation, "ENVIADO"

End With

Application.ScreenUpdating = True

Set Wb = Nothing
Set OL = Nothing
Set EmailItem = Nothing

End Sub

 
Postado : 30/11/2015 9:52 am
Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Andre, a resposta para este erro está logo no inicio da rotina nos comentários :

'Essa macro requer que sejam acrescentadas as referências
'Microsoft Outlook 12.0 (ou maior) Object Library
'Microsoft Scriping Runtime

Va no menu Ferramenta / Referencias e procure e habilite as referências : Microsoft Outlook 12.0 Object Library e Microsoft Scriping Runtime

[]s

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

 
Postado : 03/12/2015 6:38 pm
(@fazerbem)
Posts: 697
Honorable Member
Topic starter
 

Ola Mauro Coutinho, eu imaginava mesmo ser isso, mas resolvi perguntar , apesar de que nem sei mexer, seria no menu do excel ou do visaul basic ?

Grato

 
Postado : 03/12/2015 6:45 pm
Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Ola Mauro Coutinho, eu imaginava mesmo ser isso, mas resolvi perguntar , apesar de que nem sei mexer, seria no menu do excel ou do visaul basic ?
Grato

No menu da janela do VBE.

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

 
Postado : 03/12/2015 7:00 pm
(@fazerbem)
Posts: 697
Honorable Member
Topic starter
 

Pra fechar este topico, na rotina do comando tem para quem quero enviar o email, e esta entre aspas o email do destinatario. Porem não quero por ali o email e sim uma referencia de uma celula, como eu devria por ?
Assim a rotina iria na celula especificada e iria se basear por la, preciso que funcione assim.

Grato andre

 
Postado : 03/12/2015 7:04 pm
(@fazerbem)
Posts: 697
Honorable Member
Topic starter
 

Aqui

.To = "[email protected]"

Quero que pegue o que ta na celula A80 por exemplo

 
Postado : 03/12/2015 7:07 pm
Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Aqui

.To = "[email protected]"

Quero que pegue o que ta na celula A80 por exemplo

Andre, como a rotina utiliza a Propriedade "UsedRange" - ActiveSheet.UsedRange.Select onde é selecionado toda a região utilizada na aba, o ideal seria ter o endereço de email em outra aba, por exemplo a "Plan1", adicione as instruções conforme abaixo ;

Depois destas :
Dim OL As Object
Dim EmailItem As Object
Dim Wb As Workbook

'Adicione estas linhas
Dim sQualEmail
sQualEmail = Plan1.Range("A80").Value

e depois troque :
.To = "[email protected]"
por esta :
.To = sQualEmail

[]s

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

 
Postado : 03/12/2015 7:45 pm
(@fazerbem)
Posts: 697
Honorable Member
Topic starter
 

Aqui

'Adicione estas linhas
Dim sQualEmail
sQualEmail = Plan1.Range("A80").Value

e depois troque :
.To = "[email protected]"
por esta :
.To = sQualEmail

[]s

Nao deu certo o sQualEmail, pois coloquei o email: [email protected] na aba Plan2 ( A1 ) , e o unico email que recebi foi na conta onde esta .C/C

fiz algo de errado ?

Option Explicit
Sub Enviar_Email_com_PDF_Planilhnado()

'========================================================
'Essa macro requer que sejam acrescentadas as referências
'Microsoft Outlook 12.0 (ou maior) Object Library
'Microsoft Scriping Runtime
'========================================================

Dim OL As Object
Dim EmailItem As Object
Dim Wb As Workbook
Dim sQualEmail
sQualEmail = Plan2.Range("A1").Value

Application.ScreenUpdating = False
Set OL = CreateObject("Outlook.Application")
Set EmailItem = OL.CreateItem(olMailItem)
ActiveSheet.UsedRange.Select

ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
ActiveWorkbook.Path & "Temp.pdf", Quality:=xlQualityStandard _
, IncludeDocProperties:=False, IgnorePrintAreas:=False, OpenAfterPublish _
:=False

With EmailItem
.Subject = "Seu Pedido Gauer do Brasil"
.Body = "Segue anexo seu Pedido para Aprovação." & vbCrLf & _
"" & vbCrLf & _
"Obrigado!" & vbCrLf & _
"" & vbCrLf & _
"André Luiz" & vbCrLf & _
"Fone: (21)3564-2347" & vbCrLf & _
"WhatsApp: (21)98799-3381" & vbCrLf & _
"[email protected]"
.To = sQualEmail
.CC = "contato@fazerbem.com.br"
.Importance = olImportanceNormal
.Attachments.Add ActiveWorkbook.Path & "Temp.pdf"
.Send

MsgBox "RELATÓRIO ENVIADO COM SUCESSO!", vbInformation, "ENVIADO"
End With

Application.ScreenUpdating = True

Set Wb = Nothing
Set OL = Nothing
Set EmailItem = Nothing

Call ApagarArquivoTemporário(ActiveWorkbook.Path & "")
End Sub
Sub ApagarArquivoTemporário(ByVal Caminho As String)

'Desabilita a atualização automática
Application.EnableEvents = False

'Declaração de variáveis
Dim fso As Scripting.FileSystemObject
Dim fld As Scripting.Folder
Dim fl As Scripting.File

'Aqui é criado o objeto que comunica com as pastas do computador
Set fso = CreateObject("Scripting.FileSystemObject")

'Esse objeto executa um método do FileSystemObject
'para buscar atribuir à variável fld uma pasta
Set fld = fso.GetFolder(Caminho)

'Loop em cada elemento (ou seja, arquivo) do caminho desejado:
For Each fl In fld.Files
'Verifica se é um arquivo com extensão PDF
If Right(fl.Name, 3) = "PDF" Or Right(fl.Name, 3) = "pdf" Then
fl.Delete
End If
Next
'Habilita a atualização automática
Application.EnableEvents = True
End Sub

 
Postado : 04/12/2015 9:14 am
(@fazerbem)
Posts: 697
Honorable Member
Topic starter
 

quebrei mais aqui a cabeca, e de certo nao da erro de envio , mas tb, nao recebo o email, so to recebendo o email da .C/C

grato

 
Postado : 04/12/2015 11:06 am
Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

A principio está tudo correto, o que você pode fazer é verificar se o resultado na Variável está correta

adicione depois da linha :
sQualEmail = Plan2.Range("A1").Value
msgbox sQualEmail
assim será mostrado qual email está na variável, se estiver em branco é devido a definição da plan2, procure utilizar o nome que está na ABA, ela pode estar "Plan2" e ser "Plan1", veja no lado esquerdo da janela de propriedades do VBE.

Mas como eu disse procure declarar o nome da aba, da seguinte forma :

sQualEmail = Worksheets("Nome_Da_ABA").Range("A1").Value

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

 
Postado : 04/12/2015 11:20 am
(@fazerbem)
Posts: 697
Honorable Member
Topic starter
 

Obrigado a Mauro Coutinho e Vagner Morel pela ajuda, ficou chupetinha !!!

Grato de novo !!!!

André Luiz

 
Postado : 04/12/2015 11:32 am
Página 2 / 2