USUÁRIO:      SENHA:        SALVAR LOGIN ?    Adicione o VBWEB na sua lista de favoritos   Fale conosco 

 

  Fórum

  Visual Basic
Voltar
Autor Assunto:  ENVIAR RELATORIO POR EMAIL
Álvaro
Pontos: 2843
GUARULHOS
SP - BRASIL
ENUNCIADA !
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
   
Álvaro
Pontos: 2843
GUARULHOS
SP - BRASIL
ENUNCIADA !
Postada em 24/10/2011 12:37 hs            
Alguém ...
   
asdf
não registrado
ENUNCIADA !
Postada em 27/10/2011 22:30 hs   
   
Página(s): 1/1    

CyberWEB Network Ltda.    © Copyright 2000-2024   -   Todos os direitos reservados.
Powered by HostingZone - A melhor hospedagem para seu site
Topo da página