MaximoAccess

Caro Usuário, não tire as suas duvidas nas Salas de Repositório, abra sempre um novo tópico relacionado, nas salas destinadas para o efeito, como Sala de Tabelas, Consultas, Formulários, Relatórios, Macros, Módulos e VBA.

Obrigado

Administração do MaximoAccess

Dicas Ms Access, Exemplos Ms Access, Codigos VBA Ms Access, SQL Ms Access

    Importação de arquivos remessa Bradesco para Tabela - MODIFICADO

    Compartilhe

    wbonelli
    Intermediário
    Intermediário

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 58
    Registrado : 02/04/2011

    Importação de arquivos remessa Bradesco para Tabela - MODIFICADO

    Mensagem  wbonelli em Seg 14 Abr 2014, 16:33

    Boa Noite Pessoal!

    Estou necessitando muito da ajuda de vocês com uma rotina de importação de Arquivo Retorno.
    Ela funciona direitinho, até porque não foi eu quem a fez, apenas adaptei às minhas necessidades.
    Agora estou tentando melhorá-la para que faça a importação de vários arquivos ao mesmo tempo, de uma pasta expecífica.
    O caminho da pasta é obtido de um campo txtPath. e os arquivos tem a terminação .ret
    Já fiz uns testes com a modificação abaixo e funciona apenas no primeiro arquivo. Entretanto aparece no 'Debug.Print "importing " & strFile' que todos os arquivos da pasta foram tratados.

    Agradeço muito caso possam me ajudar.
    Abaixo segue a rotina:

    Dim db As Database
    Dim rs As Recordset
    Dim Linha As String
    On Error Resume Next
    Dim strDir As String
    Dim strFile As String
    Dim I As Long

    'DoCmd.OpenQuery "Qry_Limpa_Tabela_BoletosImportadosPagos" 'apaga registros anteriores
    Set db = CurrentDb
    Set rs = db.OpenRecordset("Boletos_Pagos_importar_access", dbOpenTable)

    I = 0

    If Left(txtPath, 1) <> "\" Then
    strDir = txtPath & "\"
    Else
    strDir = txtPath
    End If
    strFile = Dir(strDir & "*.ret")

    Do While strFile <> ""
    I = I + 1

    strFile = strDir & strFile
    Debug.Print "importing " & strFile

    Open strFile For Input As #1 ' Abre o arquivo a ser importado
    While Not EOF(1)

    Line Input #1, Linha ' Lê uma linha do arquivo texto
    If Left$(Linha, 1) = "1" Then
    With rs
    .AddNew

    !conta = Mid$(Linha, 21, 17)
    !Nosso_Numero = Mid$(Linha, 71, 11)
    !Documento = Mid$(Linha, 117, 10)
    !Operacao = Mid$(Linha, 109, 2)
    !valor = Mid$(Linha, 153, 13) / 100
    !emissao = Mid$(Linha, 296, 2) & "/" & _
    Mid$(Linha, 298, 2) & "/" & _
    Mid$(Linha, 300, 2)
    !valor = Mid$(Linha, 254, 13) / 100
    !juros = Mid$(Linha, 267, 13) / 100
    !Data_Pag = Mid$(Linha, 111, 2) & "/" & _
    Mid$(Linha, 113, 2) & "/" & _
    Mid$(Linha, 115, 2)
    !CNPJ = Mid$(Linha, 4, 14)
    !Sacado = Mid$(Linha, 38, 14)

    .Update
    End With

    End If

    Wend

    strFile = Dir()
    Loop

    Saida:
    Close
    Set rs = Nothing
    Set db = Nothing

    MsgBox "Arquivo Importado com Sucesso, clique em atualizar para Processar os dados"

    Exit Sub

    TrataErro:
    MsgBox Err.Description, vbExclamation + vbOKOnly, "Erro: " & CStr(Err.Number)
    #If DESENV Then ' Compilação condicional - Em desenvolvimento
    Stop
    Resume
    #End If
    Resume Saida

    wbonelli

    wbonelli
    Intermediário
    Intermediário

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 58
    Registrado : 02/04/2011

    Re: Importação de arquivos remessa Bradesco para Tabela - MODIFICADO

    Mensagem  wbonelli em Ter 15 Abr 2014, 11:40

    Bom dia Pessoal,

    Por favor, alguém tem idéia em que estou errando? Obrigado.

    wbonelli
    Intermediário
    Intermediário

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 58
    Registrado : 02/04/2011

    Re: Importação de arquivos remessa Bradesco para Tabela - MODIFICADO

    Mensagem  wbonelli em Qua 16 Abr 2014, 18:29

    Desculpem a insistência, mas estou precisando mesmo.

    Já tentei adaptar outras rotinas, como esta:

    No site JR Access Faq: [Você precisa estar registrado e conectado para ver este link.]

    Código:
    Attribute VB_Name = "basExemplos"
    Option Compare Database
    Option Explicit

    'Rotinas de Exemplo:

    ' ImportaTexto()

    Sub ImportaTexto(Tabela As String)

    ' Rotina para automatizar a importação de diversos arquivos _
      TXT (ex.: Data1.txt, Data2.txt até DataN.txt) para uma Tabela, _
      com medidor de Progresso na Barra de Status do Access
      
    ' Esta rotina foi usada para importar 3515 arquivos _
      textos para a construção deste aplicativo

        On Error GoTo erro_função
        Dim rs As Recordset, strLinha As String, TodoTexto As String
        Dim StatusTexto As String, ContaReg As Integer
     
       ContaReg = 0  'zera o contador de registros.
        Set rs = CurrentDb.OpenRecordset(Tabela)
        Screen.MousePointer = 11  'muda cursor para ampulheta.
        With rs
        'inicia a Barra de Progresso.
        StatusTexto = "Lendo Arquivos ..."
        .MoveLast
        SysCmd acSysCmdInitMeter, StatusTexto, .RecordCount
        .MoveFirst
            Do While Not .EOF
                Open "d:\Forum Access\JR\Dados\Data." & CStr(!Resposta_Id) For Input As #1
                ContaReg = ContaReg + 1
                SysCmd acSysCmdUpdateMeter, ContaReg 'atualiza o progresso.
                DoEvents 'Deve ser usada se nº de arq txt for grande.
                
                ' Lê arq txt linha a linha e salva na Tabela.
                Do Until EOF(1)
                    Line Input #1, strLinha
                    TodoTexto = TodoTexto & strLinha & vbCrLf
                Loop
                Close #1
                .Edit
                !Resposta = Trim(TodoTexto)
                .Update
                .MoveNext
                strLinha = ""
                TodoTexto = ""
            Loop
        End With
        Screen.MousePointer = 0   'volta o cursor para o normal.
        SysCmd acSysCmdRemoveMeter  'remove a ProgressBar.
        Set rs = Nothing
        MsgBox "Importados " & ContaReg & " textos com sucesso!", vbExclamation, "Fim de Operação"
        Exit Sub
        
    erro_função:
        Call InformaErro
        Screen.MousePointer = 0
        Close #1
        
    End Sub

    sem sucesso. Se deve certamente ao meu pouco conhecimento de VBA.

    Se possível, peço ajudar-me.
    Obrigado.
    Wagner[/b]

    wbonelli
    Intermediário
    Intermediário

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 58
    Registrado : 02/04/2011

    Pessoal, será que tem como me ajudar?

    Mensagem  wbonelli em Ter 29 Abr 2014, 18:49

    Pessoal, será que tem como me ajudar?
    Obrigado!

      Data/hora atual: Dom 04 Dez 2016, 01:57