Boa tarde!
Senhores, sou novato em VB e preciso de uma programação no excel onde conseguiria selecionar umas determinadas células e enviar automaticamente em tempos pre selecionados para e-mails pré selecionados.
isso usando o GMAIL e a função VB do excel.
poderiam me ajudar por favor?
ps, o arquivo do Excel contem imagens, teria que ser enviado também.
desde já, agradeço os senhores.
Thiago Begidio
Analista de planejamento Na empresa Unitono contact center -SBC -Sp
Begidio, estou imaginando que voce tem um intervalo de dados e neste intervalo voce tem imagens conforme citou. E quer que este intervalo fique visível no corpo de e-mail.
Ok isso é possível através do cdo e uma rotina que converte as células para html.
Já as imagens, para que elas ficam visível para as pessoas que receberam o e-mail. No Gmail, é necessário estarem na nuvem. Fazer o upload da imagem e inserir o link no código de envio. Ou então que envie como anexo.
É importante fazer uma ressalva, algumas empresas bloqueiam o envio de e-mail, fora do servidor padrão habilitado, talvez tenha problemas com bloqueios não autorizados. acho que é bom checar antes.
Dim iMsg As Object Dim iConf As Object Dim strbody As String Sub Enviar_Gmail() Set iMsg = CreateObject("CDO.Message") Set iConf = CreateObject("CDO.Configuration") iConf.Load -1 ' Padrões de origem do CDO Set Flds = iConf.Fields With Flds .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2 .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.gmail.com" .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25 .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/smtpconnectiontimeout") = 60 .Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "ENDEREÇO_DE_EMAIL_TITULAR_DA_CONTA@gmail.com" 'INSIRA TITULAR DA CONTA .Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "SENHA_TITULAR_DA_CONTA_GMAIL" 'INSIRA SENHA .Update End With Dim r As Range ' ALTERE O INTERVALO ABAIXO: Set r = Worksheets("Plan1").Range("A1:H20").SpecialCells(xlCellTypeVisible) With iMsg Set .Configuration = iConf .To = "ENDEREÇO_E-MAIL_DESTINATARIO@XXXXX.com.br" 'INSIRA E-MAIL DESTINATARO .CC = "" .BCC = "" .From = """Seu_Nome"" <QUEM_ESTA_ENVIANDO@gmail.com.com>" 'INSIRA E-MAIL QUEM ESTA ENVIANDO .Subject = "Teste Gmail" ' ABAIXO O LINK DA IMAGEM: .HTMLBody = "<IMG SRC="""https://s25.postimg.org/wdsn9r3mn/tela.jpg""" ALT=""Texto Opcional...."">" & _ RangetoHTML(r) .Send End With End Sub Function RangetoHTML(rng As Range) ' Changed by Ron de Bruin 28-Oct-2006 ' Working in Office 2000-2016 Dim fso As Object Dim ts As Object Dim TempFile As String Dim TempWB As Workbook TempFile = Environ$("temp") & "" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm" 'Copy the range and create a new workbook to past the data in rng.Copy Set TempWB = Workbooks.Add(1) With TempWB.Sheets(1) .Cells(1).PasteSpecial Paste:=8 .Cells(1).PasteSpecial xlPasteValues, , False, False .Cells(1).PasteSpecial xlPasteFormats, , False, False .Cells(1).Select Application.CutCopyMode = False On Error Resume Next .DrawingObjects.Visible = True .DrawingObjects.Delete On Error GoTo 0 End With 'Publish the sheet to a htm file With TempWB.PublishObjects.Add( _ SourceType:=xlSourceRange, _ Filename:=TempFile, _ Sheet:=TempWB.Sheets(1).Name, _ Source:=TempWB.Sheets(1).UsedRange.Address, _ HtmlType:=xlHtmlStatic) .Publish (True) End With 'Read all data from the htm file into RangetoHTML Set fso = CreateObject("Scripting.FileSystemObject") Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2) RangetoHTML = ts.readall ts.Close RangetoHTML = Replace(RangetoHTML, "align=center x:publishsource=", _ "align=left x:publishsource=") 'Close TempWB TempWB.Close savechanges:=False 'Delete the htm file we used in this function Kill TempFile Set ts = Nothing Set fso = Nothing Set TempWB = Nothing End Function
Fonte: https://www.rondebruin.nl/win/s1/outlook/bmail2.htm
Click em
se a resposta foi util!
Basole Bom dia!
Obrigado pela Resposta! porém não posso enviar nada em anexo. não é para utilização de envios em massa. preciso que seja enviados em horários pre determinados (como um ontime) e com conteúdo da "célula A2 até a célula X50"(exemplo) seja copiado e colado no corpo do e-mail, e logo em seguida disparado via Gmail para os destinatários pre selecionados.
No conteúdo das células existe 2 imagens + dados + gráfico, ou seja, tenho que pegar uma extensão determinada das células e colar no corpo do e-mail e em seguida enviar automaticamente isso realizando automaticamente em horários que eu decidir (13:00; 14:00; 15:00 etc)
tenho um código que realiza isso, porém esta adaptado apenas para Outlook.(usava ele no ano passado)
Segue:
Sub enviar_corpo_email_2() Dim D1 As String M = Sheets("aux.").Range("D1") Sheets("plan1").Visible = True Sheets("plan1").Select ActiveSheet.Range("B2:D61").Select ActiveWorkbook.EnvelopeVisible = True With ActiveSheet.MailEnvelope .Introduction = “” .Item.To = "teste@teste.com.br;teste.teste@teste.com.br" .Item.Subject = "MODELO " & M & "" .Item.Send End With End Sub
e ONTIME:
Private Sub Workbook_Open() Application.OnTime TimeValue("14:15:00"), Procedure:="enviar_corpo_email_2" End Sub
Preciso dessa ajuda para enviar via Gmail.
podem me ajudar?
desde já, obrigado!!
Thiago Begidio
Analista de planejamento Na empresa Unitono contact center -SBC -Sp
Boa tarde Galera!
Ainda estou travado nessa questão. Me ajudem por favor?
desde já, agradeço galera.
Thiago Begidio
Analista de planejamento Na empresa Unitono contact center -SBC -Sp