Postada em 20/10/2011 10:43 hs
Galera estou usando o crystal 9, e estou tentando enviar vários relatório por email ao mesmo tempo, só que eles não estão gerando corretamente, segue abaixo o comando
Esse comando esta no botão export do crviewer
UseDefault = False 'Cancela a exportação Set RsParametros = Db.Execute("Select * from parametros") Dim i As Double i = 0 While Not RsDadosGuardados.EOF i = i + 1 RsDadosGuardados.MoveNext Wend RsParametros.MoveMin RsDadosGuardados.MoveMin ProgressBar1.Visible = True '1095 é o espaço que os botões de enviar e imprimir ocupam no relatório ProgressBar1.Width = Me.Width - 1095 ProgressBar1.Max = i ProgressBar1.Min = 0 i = 0 While Not RsDadosGuardados.EOF If Trim(RsDadosGuardados!email) <> "" Then If TipoBoleto = "Sindical" Then CrpGuiaSind.DiscardSavedData CrpGuiaSind.SQLQueryString = strSQL & " where tbguias.nossonumero = " & RsDadosGuardados!nossoNumero CrpGuiaSind.ExportOptions.FormatType = crEFTPortableDocFormat ' Define o tipo de arquivo a exportar como pdf CrpGuiaSind.ExportOptions.DestinationType = crEDTDiskFile 'Define o Destino HD CrpGuiaSind.ExportOptions.PDFExportAllPages = True 'Todas as páginas CrpGuiaSind.ExportOptions.ExchangeFolderPath = App.Path 'A pasta onde o arquivo vai ser salvo CrpGuiaSind.ExportOptions.DiskFileName = "Guia " & TipoBoleto & " " & Replace(RsDadosGuardados!razaosocial, ".", " ") & " " & RsDadosGuardados!nossoNumero & ".pdf" 'O nome do arquivo CrpGuiaSind.Export False ' o False é para evitar a exibição das caixas de diálogo. Else CrpTitulo.DiscardSavedData CrpTitulo.SQLQueryString = strSQL & " where tbtitulos.nossonumero = " & RsDadosGuardados!nossoNumero CrpTitulo.ExportOptions.FormatType = crEFTPortableDocFormat ' Define o tipo de arquivo a exportar como pdf CrpTitulo.ExportOptions.DestinationType = crEDTDiskFile 'Define o Destino HD CrpTitulo.ExportOptions.PDFExportAllPages = True 'Todas as páginas CrpTitulo.ExportOptions.ExchangeFolderPath = App.Path 'A pasta onde o arquivo vai ser salvo CrpTitulo.ExportOptions.DiskFileName = "Boleto " & TipoBoleto & " " & Replace(RsDadosGuardados!razaosocial, ".", " ") & " " & RsDadosGuardados!nossoNumero & ".pdf" 'O nome do arquivo CrpTitulo.Export False ' o False é para evitar a exibição das caixas de diálogo. End If On Error GoTo Erro_Envia 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 .Item(cdoSMTPServer) = RsParametros!servidorsmtp .Item(cdoSMTPConnectionTimeout) = 300 ' Tempo .Item(cdoSMTPAuthenticate) = RsParametros!Autenticacao .Item(cdoSendUserName) = RsParametros!usuarioautenticacao .Item(cdoSendPassword) = RsParametros!Senha .Update End With With Msg Set .Configuration = Cof .To = RsDadosGuardados!email .From = RsParametros!EnderecoEmail 'Caso seja selecionado a empresa individual, permite colocar o título do email e quem receberá uma cópia If optEmpr.Value = True Or optCodEmpr.Value = True Then .Subject = TxtTitulo.Text .HTMLBody = TxtMensagem.Text .CC = TxtCopiaEmail.Text 'Informe o ou os destinatários da cópia Else 'Coloca um título padrão para o email .Subject = IIf((TipoBoleto) = "Sindical", "Guia ", "Boleto ") & TipoBoleto End If
' .BCC = 'Informe o ou os destinatários da cópia oculta If TipoBoleto = "Sindical" Then .AddAttachment App.Path & "Guia " & TipoBoleto & " " & Replace(RsDadosGuardados!razaosocial, ".", " ") & " " & RsDadosGuardados!nossoNumero & ".pdf" 'O nome do arquivo Else .AddAttachment App.Path & "Boleto " & TipoBoleto & " " & Replace(RsDadosGuardados!razaosocial, ".", " ") & " " & RsDadosGuardados!nossoNumero & ".pdf" 'O nome do arquivo End If .Send 'Aqui apaga o arquivo para ele não dar erro de acesso restrito, ao tentar criar um novo arquivo If TipoBoleto = "Sindical" Then Kill App.Path & "Guia " & TipoBoleto & " " & Replace(RsDadosGuardados!razaosocial, ".", " ") & " " & RsDadosGuardados!nossoNumero & ".pdf" 'O nome do arquivo Else Kill App.Path & "Boleto " & TipoBoleto & " " & Replace(RsDadosGuardados!razaosocial, ".", " ") & " " & RsDadosGuardados!nossoNumero & ".pdf" 'O nome do arquivo End If End With Else If Trim(CodEmpresaSemEmail) = "" Then CodEmpresaSemEmail = RsDadosGuardados!nossoNumero Else CodEmpresaSemEmail = CodEmpresaSemEmail & "," & RsDadosGuardados!nossoNumero End If End If RsDadosGuardados.MoveNext i = i + 1 ProgressBar1.Value = i Wend ProgressBar1.Visible = False MsgBox "Envio concluído com sucesso"
Tenho uma lista que seleciono as empresas que irão receber o boleto, então estou mandando para o email de cada empresa o boleto anexado. Quando seleciono apenas uma empresa, mando sem nenhum problema, agora quando tem mais que uma empresa, o arquivo que é enviado esta corrompido e/ou com caractesres entranhos. Alguém consegue mandar relatório por email, por demanda?
O que será q esta errado no meu código para não funcionar?
Galera agradeço a ajuda, preciso disso para entregar amanhã e não estou conseguindo
|