ENVIAR RELATORIO POR EMAIL
Meus amigos, existem muitos tutoriais de como enviar relaório por email, porém não achei nenhum que me ajudasse pois o meu relatorio tem que ser em excel, o código que uso para gera-lo é esse, gostaria que após gerado fosse exibida uma mensagem peguntando se quero ou não enviar.
[txt-color=#0000f0]Private Sub cmdprint_Click()
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) = rs!DT_AGENDADA
DataArray(r, 5) = rs!PREV_COMP
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
oBook.SaveAs [Ô]C:\Relatorio.xls[Ô]
oExcel.Quit
rs.MoveFirst
MsgBox [Ô]Relatório gerado com sucesso![Ô], 64, [Ô]Info[Ô]
Set rs = Nothing
db.Close: Set db = Nothing
End Sub[/txt-color]
[txt-color=#0000f0]Private Sub cmdprint_Click()
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) = rs!DT_AGENDADA
DataArray(r, 5) = rs!PREV_COMP
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
oBook.SaveAs [Ô]C:\Relatorio.xls[Ô]
oExcel.Quit
rs.MoveFirst
MsgBox [Ô]Relatório gerado com sucesso![Ô], 64, [Ô]Info[Ô]
Set rs = Nothing
db.Close: Set db = Nothing
End Sub[/txt-color]
após terminar de gerar o arquivo use o método desse [txt-color=#0000f0]LINK[/txt-color] e para enviar o anexo ou não você pode colocar um IF perguntando se o usuário quer ou nao enviar o email.
Espero ter ajudado
Espero ter ajudado
Citação::
após terminar de gerar o arquivo use o método desse [txt-color=#0000f0]LINK[/txt-color] e para enviar o anexo ou não você pode colocar um IF perguntando se o usuário quer ou nao enviar o email.
Espero ter ajudado
Valeu a intenção mas esse código além de complicado parece usar o outlook, quero um que envie do proprio vb6 (sei que é possivel pois no excel eu ja vi um tutorial ensinando a fazer.
colega eu não to entendendo o relatório tem que ser em excel ou em vb6, veja bem são coisas distintas (excel entendo que esteja programando uma macro do vba), porém pelo código vejo que é em vb6 que está programando, o que vc deseja é enviar uma planilha via e-mail? é isso? se não for explique melhor.
pelo que entendi, tem a necessidade de exportar os dados para excel, gerar uma planilha e encaminhar por email....tem a vbsendmail que é muito boa...
Cara envio de e-mail não é difÃcil não! Pesquise por vbSendMail.dll com vb6 ou enviar e-mail vb6 assim vera outras formas de enviar e-mail.
vai ver que existe varias outras maneiras essa que te passe é uma delas.
vai ver que existe varias outras maneiras essa que te passe é uma delas.
Citação::
colega eu não to entendendo o relatório tem que ser em excel ou em vb6, veja bem são coisas distintas (excel entendo que esteja programando uma macro do vba), porém pelo código vejo que é em vb6 que está programando, o que vc deseja é enviar uma planilha via e-mail? é isso? se não for explique melhor.
Isso mesmo marcelo, exporto o arquivo do VB6 para excel e desejo envia-la
Citação::
pelo que entendi, tem a necessidade de exportar os dados para excel, gerar uma planilha e encaminhar por email....tem a vbsendmail que é muito boa...
Isso mesmo...
AMigo tenta isso eu peguei em um site mas não lembro onde:
Sub manda_email(Nome As String, Email As String, Senha As String, Assunto As String, Mensagem As String, EmailDestino As String)
Dim Message, Configuration, Fields, schema
Set Message = CreateObject([Ô]CDO.Message[Ô])
Set Configuration = CreateObject([Ô]CDO.Configuration[Ô])
Set Fields = Configuration.Fields
schema = [Ô]http://schemas.microsoft.com/cdo/configuration/[Ô]
Fields.Item(schema & [Ô]sendusing[Ô]) = 2
Fields.Item(schema & [Ô]smtpserver[Ô]) = [Ô]smtp.gmail.com[Ô]
Fields.Item(schema & [Ô]smtpserverport[Ô]) = 465
Fields.Item(schema & [Ô]smtpauthenticate[Ô]) = 1
Fields.Item(schema & [Ô]smtpConnectionTimeout[Ô]) = 150
Fields.Item(schema & [Ô]sendusername[Ô]) = Email
Fields.Item(schema & [Ô]sendpassword[Ô]) = Senha
Fields.Item(schema & [Ô]smtpusessl[Ô]) = 1
Fields.Update
With Message
.To = EmailDestino
.From = Nome & [Ô]<[Ô] & Email & [Ô]>[Ô]
.Subject = Assunto
.TextBody = Mensagem
.HTMLBody = [Ô]This is a test.[Ô] [ô]change this to the body of the email
.Sender = Nome
Set .Configuration = Configuration
Message = .Send
End With
Set Message = Nothing
Set Configuration = Nothing
Set Fields = Nothing
End Sub
Sub manda_email(Nome As String, Email As String, Senha As String, Assunto As String, Mensagem As String, EmailDestino As String)
Dim Message, Configuration, Fields, schema
Set Message = CreateObject([Ô]CDO.Message[Ô])
Set Configuration = CreateObject([Ô]CDO.Configuration[Ô])
Set Fields = Configuration.Fields
schema = [Ô]http://schemas.microsoft.com/cdo/configuration/[Ô]
Fields.Item(schema & [Ô]sendusing[Ô]) = 2
Fields.Item(schema & [Ô]smtpserver[Ô]) = [Ô]smtp.gmail.com[Ô]
Fields.Item(schema & [Ô]smtpserverport[Ô]) = 465
Fields.Item(schema & [Ô]smtpauthenticate[Ô]) = 1
Fields.Item(schema & [Ô]smtpConnectionTimeout[Ô]) = 150
Fields.Item(schema & [Ô]sendusername[Ô]) = Email
Fields.Item(schema & [Ô]sendpassword[Ô]) = Senha
Fields.Item(schema & [Ô]smtpusessl[Ô]) = 1
Fields.Update
With Message
.To = EmailDestino
.From = Nome & [Ô]<[Ô] & Email & [Ô]>[Ô]
.Subject = Assunto
.TextBody = Mensagem
.HTMLBody = [Ô]This is a test.[Ô] [ô]change this to the body of the email
.Sender = Nome
Set .Configuration = Configuration
Message = .Send
End With
Set Message = Nothing
Set Configuration = Nothing
Set Fields = Nothing
End Sub
o código de cima está correto mas não explica como enviar o anexo, vou explicar como fazer para enviar o email, com anexo, que seria seu caso, pois você vai criar o documento excel primeiro e depois envia-lo, veja
vá em Project\References e marque MICROSOFT CDO FOR WINDOWS 2000 LIBRARY
feito isso
cole este código no projeto
repare no final onde vc vai colocar o anexo que é documento xls
vá em Project\References e marque MICROSOFT CDO FOR WINDOWS 2000 LIBRARY
feito isso
cole este código no projeto
Dim Msg As CDO.Message
Dim Cof As CDO.Configuration
Dim Camp
Set Msg = New CDO.Message
Set Cof = New CDO.Configuration
Set Camp = Cof.Fields
With Camp
.Item(cdoSendUsingMethod) = 2 [ô] cdoSendUsingPort
.Item(cdoSMTPServer) = [Ô]mail.seuprovedor.com.br[Ô] [ô][Ô]smtp.mail.yahoo.com.br[Ô] ‘informe o servidor smtp aqui
.Item(cdoSMTPConnectionTimeout) = 20 [ô] quick timeout
.Item(cdoSMTPAuthenticate) = 1
.Item(cdoSendUserName) = [Ô]seu_usuario@abobora.com.br[Ô] [ô] informe o usuario de autenticação
.Item(cdoSendPassword) = [Ô]suasenha[Ô] [ô]Informe a Senha aqui
.Update
End With
With Msg
Set .Configuration = Cof
.To = [Ô]destinatario1@email.com.br;destinatario2@email.com.br[Ô] [txt-color=#007100][ô] destinatarios separados por ;[/txt-color]
.From = [Ô]seuemail@bol.com.br[Ô]
.Subject = [Ô]Feliz Aniversário![Ô]
.HTMLBody = strHTML
[txt-color=#007100] [ô].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[/txt-color]
.AddAttachment [Ô]c:\pasta\documento.xls[Ô] [txt-color=#007100][ô] aqui você informa o ou os anexos[/txt-color]
.Send
End With
repare no final onde vc vai colocar o anexo que é documento xls
Marcelo,
modifiquei algumas coisas no codigo pois estavam dando erro, ficou assim:
Set .Configuration = Cof
.To = [Ô]m4r100@bol.com.br[Ô] [ô]retirei o MyEmail_Cli
.From = [Ô]mariomotosol@gmail.com[Ô]
.Subject = [Ô]Relatorio![Ô]
[ô].HTMLBody = strHTML [ô]Comentei esta linha
.AddAttachment [Ô]c:\Relatorio.xls[Ô] [ô] aqui você informa o ou os anexos
mas não funcionou, o código executa sem erros mas o email não é enviado.
O smtp do gmail é [Ô]smtp.googlemail.com[Ô] ? pois foi esse que usei.
modifiquei algumas coisas no codigo pois estavam dando erro, ficou assim:
Set .Configuration = Cof
.To = [Ô]m4r100@bol.com.br[Ô] [ô]retirei o MyEmail_Cli
.From = [Ô]mariomotosol@gmail.com[Ô]
.Subject = [Ô]Relatorio![Ô]
[ô].HTMLBody = strHTML [ô]Comentei esta linha
.AddAttachment [Ô]c:\Relatorio.xls[Ô] [ô] aqui você informa o ou os anexos
mas não funcionou, o código executa sem erros mas o email não é enviado.
O smtp do gmail é [Ô]smtp.googlemail.com[Ô] ? pois foi esse que usei.
Tópico encerrado , respostas não são mais permitidas