ENVIAR RELATORIO POR EMAIL

MARCELO.TREZE 07/02/2014 01:27:31
#434403
ai colega 100% funcional, testado aqui pela minha conta do gmail

Private Sub Command1_Click()
Dim Msg As CDO.Message
        Dim Cof As CDO.Configuration
        Dim Camp
        Set Msg = New CDO.Message
        Set Cof = New CDO.Configuration
        Cof.Load -1
        Set Camp = Cof.Fields
        With Camp
        
             .Item(cdoSendUsingMethod) = 2   [ô] cdoSendUsingPort
             .Item(cdoSMTPServerPort) = 25   [ô]porta 25 e usada na maioria dos servidores
             .Item(cdoSMTPServer) = [Ô]smtp.gmail.com[Ô] 
             .Item(cdoSMTPUseSSL) = 1
             .Item(cdoSMTPConnectionTimeout) = 20 
             .Item(cdoSMTPAuthenticate) = 1
             .Item(cdoSendUserName) = [Ô]seu_email@gmail.com[Ô] 
             .Item(cdoSendPassword) = [Ô]sua_senha[Ô]
             .Update
        End With

    With Msg
    
      Set .Configuration = Cof
      
          .To = [Ô]m4r100@bol.com.br[Ô] [ô] destinatarios separados por ;
          .From = [Ô]seu_email@gmail.com[Ô]
          .Subject = [Ô]Titulo do email[Ô]
          [ô].HTMLBody = [Ô]aqui você coloca o conteudo do email ex: Sr Joaquim venho por meio deste...[Ô]
          [ô].CC = [ô]Informe o ou os destinatários da cópia
          [ô].BCC = [Ô]contatos@flowsys.com.br[Ô]   [ô]Informe o ou os destinatários da cópia oculta
          .AddAttachment [Ô]C:\pasta\arquivo.xlsx[Ô] [ô] aqui você informa o ou os anexos
          .Send
          
    End With
    DoEvents
    MsgBox [Ô]Email enviiado com sucesso![Ô]
End Sub



pode usar ta testado e aprovado

ps: se não funcionar verifique se o POP e o IMAP estão ativados na configuração do GMAIL
MARIOANDRADE 07/02/2014 22:24:02
#434431
Marcelo,

O seu código está perfeito, mas quando envio por esse sistema o arquivo simplesmente chega totalmente corrompido, criei com o formato .xls e .xlsx quando envio pelo modo tradicional (o mesmo aquivo para nao ter duvidas se corrompeu no momento em que foi gerado) ele chega sem problemas mas com o código ele corrompe.

Sabe o que poderia ser ?

Eu estava pensando se houvesse um modo de zipar o arquivo após a criação, talvez evitasse ser corrompido ao ser enviado, talvez....esse é o codigo que uso pra gerar se tiver como zipar me dá essa força aí:



[txt-color=#0000f0]Dim oExcel As Object
Dim oBook As Object
Dim oSheet As Object


Set oExcel = CreateObject([Ô]Excel.Application[Ô])
Set oBook = oExcel.Workbooks.Add

Dim DataArray(1 To 200, 1 To 5) As Variant

Dim r As Integer
Dim NumberOfRows As Integer
ConnectDB

rs.Open [Ô]Select * from tblCad where DT_AGENDADA between # [Ô] & VBA.Format(dtpADtAg.Value, [Ô]mm/dd/yyyy[Ô]) & [Ô]# and #[Ô] & VBA.Format(dtpAPrevComp.Value, [Ô]mm/dd/yyyy[Ô]) & [Ô]# [Ô], db, 3, 3


If rs.RecordCount < 0 Then
MsgBox [Ô]Nenhum cliente agendado nesta data![Ô], vbInformation, [Ô]M4R10 - Soluções para sua empresa![Ô]
Set rs = Nothing
db.Close: Set db = Nothing

Exit Sub
End If
On Error Resume Next
For r = 1 To rs.RecordCount
NumberOfRows = rs.RecordCount

DataArray(r, 1) = rs!Nome
DataArray(r, 2) = rs!CELULAR
DataArray(r, 3) = rs!MOTO
DataArray(r, 4) = [Ô][Ô] & VBA.Format(rs!DT_AGENDADA, [Ô]mm/dd/yyyy[Ô])
DataArray(r, 5) = [Ô][Ô] & VBA.Format(rs!PREV_COMP, [Ô]mm/dd/yyyy[Ô])



rs.MoveNext
Next
Set oSheet = oBook.Worksheets(1)
oSheet.Range([Ô]A1:E1[Ô]).Font.Bold = True
oSheet.Range([Ô]A1:E1[Ô]).Value = Array([Ô]Nome[Ô], [Ô]Telefone[Ô], [Ô]Moto Desejada[Ô], [Ô]DT Agendada[Ô], [Ô]Prev_Comp[Ô])

oSheet.Range([Ô]A2[Ô]).Resize(NumberOfRows, 5).Value = DataArray
oSheet.Range([Ô]A:E[Ô]).EntireColumn.Autofit
oSheet.Range([Ô]D:E[Ô]).EntireColumn.Format = [Ô]mm/dd/yyyy[Ô]
oBook.SaveAs [Ô]C:\Relatorio.xlsx[Ô]
oExcel.Quit


rs.MoveFirst

MsgBox [Ô]Relatório gerado com sucesso![Ô], 64, [Ô]Info[Ô]
Set rs = Nothing
db.Close: Set db = Nothing[/txt-color]
MARCELO.TREZE 07/02/2014 23:51:01
#434432
faz o seguinte o seu em seu código algo pode estar corrompendo o arquivo

teste criar um projeto só para envio, e envie o arquivo criado pelo programa.

faça este teste
MARIOANDRADE 08/02/2014 21:37:36
#434452
Marcelo,
agradeço mesmo sua atenção, fiz todos os testes possíveis, criei arquivos manualmente, zipei,mudei a extensão deles (.xls , .xlsx, até a .xlm eu coloquei e olha que nem sabia que existia) , testei todos eles antes de enviar, os enviei ao modo tradicional, mas por fim absolutamente todos chegam corrompidos ao serem enviados via código, até o que foi zipado.

Pra não dizer que nada funciona, criei um arquivo de texto [Ô]Relatorio.txt[Ô] e esse chegou intacto, porem eu preciso
desse Relatório em Excel.
MARIOANDRADE 08/02/2014 22:01:39
#434453
Marcelo, consegui, muito obrigado, encontrei um outro código muito parecido com o seu (só não tinha a parte do anexo então copiei do seu e deu tudo certo, valeu mesmo pela força.

Sub Enviar ()
Dim iMsg As CDO.Message
Dim iConf As CDO.Configuration
Dim Flds


Set iMsg = CreateObject([Ô]CDO.Message[Ô])
Set iConf = CreateObject([Ô]CDO.Configuration[Ô])
Set Flds = iConf.Fields

[ô] send one copy with Google SMTP server (with autentication)
Schema = [Ô]http://schemas.microsoft.com/cdo/configuration/[Ô]
Flds.item(Schema & [Ô]sendusing[Ô]) = 2
Flds.item(Schema & [Ô]smtpserver[Ô]) = [Ô]smtp.gmail.com[Ô]
Flds.item(Schema & [Ô]smtpserverport[Ô]) = 465
Flds.item(Schema & [Ô]smtpauthenticate[Ô]) = 1
Flds.item(Schema & [Ô]sendusername[Ô]) = [Ô]mariomotosol@gmail.com[Ô]
Flds.item(Schema & [Ô]sendpassword[Ô]) = [Ô]senhadoemail[Ô]
Flds.item(Schema & [Ô]smtpusessl[Ô]) = 1
Flds.Update

With iMsg
.To = [Ô]luzia.admvendas@hotmail.com.br[Ô]
.From = [Ô]mariomotosol@gmail.com[Ô]
.Subject = [Ô]Clientes Agendados[Ô]
.HTMLBody = [Ô]Relarorio em anexo[Ô]
.AddAttachment [Ô]C:\Relatorio.xlsx[Ô]
Set .Configuration = iConf
.Send
End With

Set iMsg = Nothing
Set iConf = Nothing
Set Flds = Nothing
MsgBox [Ô]Email enviiado com sucesso![Ô]
End Sub
Página 2 de 2 [15 registro(s)]
Tópico encerrado , respostas não são mais permitidas
Voltar