Fórum Excel Bácico, Avançado e Vba

Este fórum é destina a usuário de Excel, que queiram compartilhar informações a básicas, avançadas e programação em VBA...
 
InícioInício  FAQFAQ  BuscarBuscar  MembrosMembros  GruposGrupos  Registrar-seRegistrar-se  Login  

Compartilhe | 
 

 resolvido macro excel: enviar email + planilha anexa + copiar a célula A1 e colar no assunto e corpo de e-mail, outlook resolvido

Ver o tópico anterior Ver o tópico seguinte Ir em baixo 
AutorMensagem
carmelito



Mensagens : 2
Data de inscrição : 29/01/2013

MensagemAssunto: resolvido macro excel: enviar email + planilha anexa + copiar a célula A1 e colar no assunto e corpo de e-mail, outlook resolvido   Ter Jan 29, 2013 4:13 am

OLá!
"antes de tudo, tentei procurar, pesquisar no google, mas não achei nada parecido, por isso que peço ajuda de vocês." Também não consegui entender os códigos do link:
.rondebruin.nl/cdo.htm" por isso que estou aqui pra pedir ajuda.

Será que podem me ajudar, preciso enviar um e-mail, criei uma planilha de excel, com um botão, o botão tem vários códigos, entre eles, o de enviar e-mail que segue, no entanto, preciso inserir no assunto o título: "Segue em anexo o edital x" ( x corresponde a célula A1 do arquivo criado).
e no body escrever: "Segue o x (x é a célula A1 do arquivo criado) atualizado, favor, inserir o arquivo em anexo na intranet.
Obrigado.
Atenciosamente,
fulano."


Isso que eu queria que constasse no código abaixo, (a parte do código que envia o email) quem puder ajudar, será bem vindo.


Sub EnviarEmailPlanilhaEspecifica()
2 Dim NovoArquivoXLS As Workbook
3 Dim sPlanAEnviar As String
4 Dim sExcluirAnexoTemporario As String
5
6 'Define a planilha que será enviada por email. Ex.: Plan1, Balancete, Lista De Nomes, etc
7 sPlanAEnviar = "Plan1"
8
9 'Cria um novo arquivo excel
10 Set NovoArquivoXLS = Application.Workbooks.Add
11
12 'Copia a planilha para o novo arquivo criado
13 ThisWorkbook.Sheets(sPlanAEnviar).Copy Before:=NovoArquivoXLS.Sheets(1)
14
15 'Salva o arquivo
16 NovoArquivoXLS.SaveAs ThisWorkbook.Path & "\" & sPlanAEnviar & ".xls"
17 sExcluirAnexoTemporario = NovoArquivoXLS.FullName
18
19 'Envia o email
20 NovoArquivoXLS.SendMail "xxxx@xxx.x", "Título do Email teste"
21
22 'Fecha o arquivo novo
23 NovoArquivoXLS.Close
24
25 'Exclui o arquivo criado apenas para ser enviado.
26 Kill sExcluirAnexoTemporario
'27 Sheets("Plan1").cell.ClearContents
28 End Sub




segue o código inteiro do botão: (importante: o resto do código acima do Sub EnviarEmailPlanilhaEspecifica() está totalmente certo, é exatamente isso que eu quero que acontceça, o problema é o código do Sub EnviarEmailPlanilhaEspecifica() que não consigo resolver, por favor, alguém pode ajudar? obrigado.




Sub Copiar_AleVBA()


Application.ScreenUpdating = False
Sheets("Plan1").Cells.ClearContents
ThisWorkbook.Sheets("edital").Range("a1:m1000").Copy
With Sheets("Plan1").Range("A" & Rows.Count).End(xlUp)
.PasteSpecial xlPasteFormats
.PasteSpecial xlPasteValues
Selection.Columns.AutoFit
Selection.Rows.AutoFit
End With
Application.CutCopyMode = False
Application.ScreenUpdating = True

Call Delet_AleVBA
End Sub
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
'Ajustar linha e coluna automaticamente
For Each cell In Target
If Len(cell.Value) > 5 Then
Columns(cell.Column).EntireColumn.AutoFit
Rows(cell.Row).EntireRow.AutoFit

End If
Next cell
End Sub



Sub Delet_AleVBA()
Dim lRows As Long
Sheets("Plan1").Select
With Range("A7:M7")
.AutoFilter
.AutoFilter Field:=5, Criteria1:="sim"
End With
Selection.Columns.AutoFit
Selection.Rows.AutoFit
Application.Calculation = xlCalculationManual
For lRows = ActiveSheet.UsedRange.Rows.Count To 1 Step -1
If Cells(lRows, 1).EntireRow.Hidden = True Then Cells(lRows, 1).EntireRow.Delete
Next lRows
ActiveSheet.AutoFilterMode = False
Application.Calculation = xlCalculationAutomatic
Selection.Columns.AutoFit
Selection.Rows.AutoFit
Call EnviarEmailPlanilhaEspecifica
End Sub
Sub EnviarEmailPlanilhaEspecifica()
Dim NovoArquivoXLS As Workbook
Dim sPlanAEnviar As String
Dim sExcluirAnexoTemporario As String

'Define a planilha que será enviada por email. Ex.: Plan1, Balancete, Lista De Nomes, etc
sPlanAEnviar = "Plan1"

'Cria um novo arquivo excel
Set NovoArquivoXLS = Application.Workbooks.Add

'Copia a planilha para o novo arquivo criado
ThisWorkbook.Sheets(sPlanAEnviar).Copy Before:=NovoArquivoXLS.Sheets(1)

'Salva o arquivo
NovoArquivoXLS.SaveAs ThisWorkbook.Path & "\" & sPlanAEnviar & ".xls"
sExcluirAnexoTemporario = NovoArquivoXLS.FullName

'Envia o email
NovoArquivoXLS.SendMail "xxxx@xxx.x", "Título do Email teste"


'Fecha o arquivo novo
NovoArquivoXLS.Close

'Exclui o arquivo criado apenas para ser enviado.
Kill sExcluirAnexoTemporario
'27 Sheets("Plan1").cell.ClearContents

End Sub


Última edição por carmelito em Ter Jan 29, 2013 10:05 pm, editado 1 vez(es)
Voltar ao Topo Ir em baixo
Ver perfil do usuário
carmelito



Mensagens : 2
Data de inscrição : 29/01/2013

MensagemAssunto: Re: resolvido macro excel: enviar email + planilha anexa + copiar a célula A1 e colar no assunto e corpo de e-mail, outlook resolvido   Ter Jan 29, 2013 10:03 pm

não precisa mais, outro forum me ajudou, agradeço ajuda de todos. obrigado.
Voltar ao Topo Ir em baixo
Ver perfil do usuário
 
resolvido macro excel: enviar email + planilha anexa + copiar a célula A1 e colar no assunto e corpo de e-mail, outlook resolvido
Ver o tópico anterior Ver o tópico seguinte Voltar ao Topo 
Página 1 de 1
 Tópicos similares
-
» Modificar local de cadastro e enviar email a todos membros
» Enviar email
» Não consigo enviar e-mail em massa
» receber um email quando o link cair
» Enviar e-mail access pelo outlook 2010

Permissão deste fórum:Você não pode responder aos tópicos neste fórum
Fórum Excel Bácico, Avançado e Vba :: Avançado/VBA :: Excel Avançado/VBA-
Ir para: