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
