locked
Como Alterar o Código para conectar o Banco versão 2007 RRS feed

  • Pergunta


  • Boa Tarde!!!

    Esse código funcionava normal na versão do Acess 2003, converti o Banco para a versão 2007 da um erro falando formato de verão do banco accdb não reconhecido.
    Alguem sabe me dizer como arrumar?

    Grato.


    Option Explicit
    Dim Diretorio, NomeArquivo, Origem
    Dim db2 As Database
    Dim Dia1, Dia2, DiaP, MesP, AnoP As String
    Dim Ponto_de_Coleta, Status As String
    Dim SqlString, Passageiros_Por_Ponto_de_Coleta, TarifaOrg, Calculo, TarifaTrabalhada



    Sub Importar_Passageiros()

    Call Conectar_Banco


    Call Checar_Dados

    Call Desconectar_Banco

    End Sub

    Sub Conectar_Banco()

    Diretorio = ThisWorkbook.Path
    'Atribui a variavel "Diretorio" o diretorio atual dos arquivos

    NomeArquivo = ThisWorkbook.Name
    'Atribui a variavel "NomeArquivo" o nome do arquivo excel

    Origem = Worksheets("Configurações").Cells(3, 13) & "\" & Worksheets("Configurações").Cells(3, 12)
    'Atribui a variavel "Origem" o diretorio e o nome do banco de dados
    Set dbs2 = OpenDatabase(Origem)


    End Sub
    Sub Desconectar_Banco()

    dbs2.Close

    End Sub

    Sub Checar_Dados()


    Do Until IsEmpty(Worksheets("Passageiros").Cells(2, 1))
        If Worksheets("Passageiros").Cells(2, 1) = "" _
        Or Worksheets("Passageiros").Cells(2, 2) = "" _
        Or Worksheets("Passageiros").Cells(2, 21) = "" Then
            MsgBox "Informações incompletas para importação", vbOKOnly
            Exit Sub
        Else
            Worksheets("Passageiros - Menu").Cells(9, 3) = Worksheets("Passageiros").Cells(2, 1)
            Call Excluir_Registro
            'Chama a rotina para excluir registro que serão alterados no banco de dados
            Call Incluir_Registro
            'Chama a rotina para incluir registro no banco de dados
        End If
    Loop

    End Sub

    Sub Excluir_Registro()

    Dia1 = Worksheets("Passageiros").Cells(2, 1)
    'Atribui a variavel "Dia1" a data da celula B2 na planilha "IO - Empresa"

    DiaP = Day(Dia1)
    'Atribui somente o dia da variavel "Dia1" na variavel "DiaP"

    MesP = Month(Dia1)
    'Atribui somente o mês da variavel "Dia1" na variavel "MesP"

    AnoP = Year(Dia1)
    'Atribui somente o ano da variavel "Dia1" na variavel "AnoP"

    Dia2 = MesP & "/" & DiaP & "/" & AnoP
    'Dia2 = Dia1
    'Remonta a ordem do dia na variavel Dia1 ( anterior dd/mm/aaaa para mm/dd/aaaa )

    Ponto_de_Coleta = Worksheets("Passageiros").Cells(2, 2)
    'Atribui a variavel "Lote" o numero do lote na celula "A2"

    Status = Worksheets("Passageiros").Cells(2, 21)

    TarifaOrg = Worksheets("Passageiros").Cells(2, 5)
    Call Tratar_Numero
    TarifaTrabalhada = Worksheets("Passageiros").Cells(2, 5)
    Calculo = Worksheets("Passageiros").Cells(2, 4)


    'Lote = "'" & Lote & "'"
    Status = "'" & Status & "'"
    Calculo = "'" & Calculo & "'"
    'Atribui a variavel "Status" o numero do lote na celula "W2"

    On Error GoTo ErrorRegistroNaoExiste
    'Indica tratamento de erro


    SqlString = "SELECT * FROM Passageiros_Por_Ponto_de_Coleta WHERE Data_Operacao = #" & Dia2 & "#"

    SqlString = SqlString & " And Ponto_de_ColetaD = " & Ponto_de_Coleta
    SqlString = SqlString & " And TarifaD = " & TarifaTrabalhada
    SqlString = SqlString & " And CalculoD = " & Calculo
    SqlString = SqlString & " And StatusD = " & Status

    'Expressão em SQL

    Set Passageiros_Por_Ponto_de_Coleta = dbs2.OpenRecordset(SqlString)


    With Passageiros_Por_Ponto_de_Coleta
        .Delete
        .Close
    End With
    Exit Sub
    ErrorRegistroNaoExiste:
    Passageiros_Por_Ponto_de_Coleta.Close

    End Sub

    Sub Incluir_Registro()


    'Rotina para Incluir Novos Registros no Banco de Dados


    Set Passageiros_Por_Ponto_de_Coleta = dbs2.OpenRecordset("Passageiros_Por_Ponto_de_Coleta")

        With Passageiros_Por_Ponto_de_Coleta
            .AddNew
            !Data_Operacao = Worksheets("Passageiros").Cells(2, 1)
            !Ponto_de_ColetaD = Worksheets("Passageiros").Cells(2, 2)
            !CalculoD = Worksheets("Passageiros").Cells(2, 4)
            !TarifaD = TarifaOrg
            !Bordo = Worksheets("Passageiros").Cells(2, 6)
            !Comum = Worksheets("Passageiros").Cells(2, 7)
            !Estudantes = Worksheets("Passageiros").Cells(2, 8)
            !VT = Worksheets("Passageiros").Cells(2, 9)
            !Sem_Credito = Worksheets("Passageiros").Cells(2, 10)
            !Gratuidade = Worksheets("Passageiros").Cells(2, 11)
            !Idoso = Worksheets("Passageiros").Cells(2, 12)
            !Int_Estudante = Worksheets("Passageiros").Cells(2, 14)
            !Int_VT = Worksheets("Passageiros").Cells(2, 15)
            !Int_Comum = Worksheets("Passageiros").Cells(2, 16)
            If Worksheets("Passageiros").Cells(2, 17) = "" Then
                Worksheets("Passageiros").Cells(2, 17) = 0
            End If
            !Int_Sem_Credito = Worksheets("Passageiros").Cells(2, 17)
            !Metro_CPTM = Worksheets("Passageiros").Cells(2, 19)
            !StatusD = Worksheets("Passageiros").Cells(2, 21)
            .Update
            .Close
        End With
        'Inclusão de dados no banco de dados

    Worksheets("Passageiros").Rows(2).Delete Shift:=xlUp
    'Deleta a linha de dados da planilha de excel incluídos no banco de dados

    End Sub

    Sub Tratar_Numero()


    Range("E2").Select
        Range("DA2").Formula = "=TEXT(C[-100],""#.##0,00"")"
        Range("DA2").Formula = "=SUBSTITUTE(C[-100],"","",""."")"
        
    Range("DA2").Select
        Selection.Copy
        Range("E2").Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
        Application.CutCopyMode = False
        
    End Sub


    Lango
    terça-feira, 1 de março de 2011 18:41

Todas as Respostas