Copiar em outra planilha, criar novo arquiva p envio p email

2024 - VBA & Macros

Post Recente por rsiqueir 10 anos atrás

3 Posts

2 Usuários

0 Reactions

1,092 Visualizações

RSS

rsiqueir

(@rsiqueir)

Posts: 39

Eminent Member

Topic starter

Boa noite Pessoal,

Preciso da ajuda e conhecimento de vcs, encaminho em anexo 2 arquivos, 1o. possui uma macro que copia os dados da planilha origem para uma planilha destino.

- Preciso que esses dados copiados não sobrepõem os dados já existentes na planilha destino, a linha que possui o total pode ser sobreposta.
- Preciso de uma macro caso exista, que crie um novo arquivo somente com os dados copiados, e que seja anexado ao email, se possível esse arquivo deverá ser nomeado com dados da célula C2 & "concatenando" H2.

Aceito sugestões, e ou, exemplos de arquivos já existentes.

Obs.: Os arquivos em anexo, estão com caminho do meu Desktop, caso efetuem teste, deverá alterar na macro

Obrigado a todos.

Rsiqueir

Clearing.xlsm

teste.xlsx

Postado : 29/05/2015 8:18 pm

Miguel 70

(@miguel-70)

Posts: 207

Estimable Member

'Este código não usa Outlook é direto do Excel, cole o código em um modulo.

Sub EnviarEmail() 'VC pode usar HOTMAIL ou GMAIL, se gmail mude as duas configurações abaixo
Application.ScreenUpdating = False
Dim oMensagem As Object
Dim oConfiguração As Object
Dim sCorpo As String
Dim vFields As Variant
Dim objWS As Object
Dim strCaminho As String
On Error GoTo debugs
Set objWS = CreateObject("WScript.Shell")
strCaminho = "C:UsersDellDesktopteste.xlsx"
'linha branco
Set oMensagem = CreateObject("CDO.Message")
Set oConfiguração = CreateObject("CDO.Configuration")
oConfiguração.Load -1 'Padrões CDO
Set vFields = oConfiguração.Fields
With vFields
.Item(" http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
.Item(" http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.live.com" 'se e-mail cadastrado for hotmail
' .Item(" http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.gmail.com" 'se e-mail cadastrado for gmail
.Item(" http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25 ''se e-mail cadastrado for hotmail
' .Item(" http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 465 'se e-mail cadastrado for gmail
.Item(" http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
.Item(" http://schemas.microsoft.com/cdo/configuration/smtpusessl") = "true"
.Item(" http://schemas.microsoft.com/cdo/configuration/sendusername") = "[email protected]"
.Item(" http://schemas.microsoft.com/cdo/configuration/sendpassword") = "senha email"
.Update
On Error GoTo debugs
End With
With oMensagem
Set .Configuration = oConfiguração
.To = Plan1.Range("P1") '"se fixo entre aspas" 'DESTINATÁRIO DO E-MAIL, vc pode criar uma lista - plan1.range("P1") pode se criar uma lista com varios e-mail destin.
.cc = "" 'com cópia
.BCC = "" 'com cópia oculta
.From = """"" <[email protected]>" 'meu e-mail cadastrado
.Subject = "Titulo do Email Aqui" 'TITULO DO E-MAIL vc pode tambem designar uma c~elula - plan1.range("p2")
.TextBody = sCorpo
.AddAttachment strCaminho
.Send
MsgBox "E-mail Enviado com Sucesso"
End
debugs:
If Err.Description <> "" Then MsgBox Err.Description, vbInformation, "Alerta de Erro de Envio do E-mail ! ! ! ! ! ! ! ! ! ! "
Application.ScreenUpdating = True
End
End With
End Sub
'se configurar conta do gmail e der erro de envio, entre no gmail click em - conta,
'Permitir aplicativos menos seguros: DESATIVADA

Postado : 30/05/2015 12:41 pm