Ir para conteúdo
Fórum Script Brasil
  • 0

Erro_importacao

analistasysbh

Perguntado por analistasysbh,

 Share

Pergunta

analistasysbh

analistasysbh

Postado
Postado

Prezados,

Estou com um novo problema na importação de arquivos texto. Estou recebendo uma mensagem de erro em tempo de execução (run-time error), informando que o tamanho do campo é muito pequeno para aceitar o valor que está se tentando inserir.

Abaixo transcrevo a mensagem de erro que estou recebendo:

<<

Run-time error '-2147217833(80040e57)':

The field is too small to accept the amount of data you attempted to add. Try inserting or pasting less data.

>>

O campo que está referenciando este erro tem participa do relacionamento da tabela-pai (origem) e a tabela-filho (onde estão sendo gravados os dados). Tanto na tabela-pai quanto na tabela-filho este campo tem o mesmo tamanho de dados (inteiro longo), porém na tabela-pai possue o tipo de dados de AutoNumeração com a opção de Incremento para o item NovosValores e na tabela-filho (dados gravados) está com o tipo de dados número.

Caso queiram dar uma olhada no código-fonte e obter maiores informações, favor me contactarem através do email: jackson_analista@yahoo.com.br.

Tenho uma certa urgência em solucionar este problema.

Ficarei muito grato se alguém puder me ajudar.

Atenciosamente,

Jackson Arruda

Analista de Sistemas

jackson_analista@yahoo.com.br

Link para o comentário
Compartilhar em outros sites

3 respostass a esta questão

Posts Recomendados

  • 0
analistasysbh

analistasysbh

Postado
  • Autor
Postado

Posso postar sim, sem problemas....

Abaixo transcrevo o fonte em arquivo texto (.TXT) referente as rotinas relacionadas com o formulário de importação (frmImportar).

O erro está ocorrendo na rotina:

Private Sub GravaTblSada()

.

.

.

End Sub

Qualquer coisa, pode me contactar em: jackson_analista@yahoo.com.br

FrmImportar:

Option Explicit

Dim bParar As Boolean

Dim linhasTxt As Long

Private Sub cmdFechar_Click()

Unload Me

End Sub

Private Function ContIniciaBarraProgressso()

On Error GoTo Error_Handler 'Ativa a rotina de tratamento de erro

ProgressBar1.Min = 0

ProgressBar1.Max = linhasTxt - 1

ProgressBar1.Value = 0

ProgressBar1.Visible = True

Exit Function

Error_Handler: 'Rotina de tratamento de erro

Call Err.Raise(Err.Number, ErrSource("FrmImportar", "ContIniciaBarraProgresso()"), Err.Description, Err.HelpFile, Err.HelpContext)

Err.Clear

End Function

Private Function BuscaCodClienteFiat(ByVal Numero As Long, Nome As String) As Integer

' Dim rsCliente As adodb.Recordset

'

' Set rsCliente = New adodb.Recordset

' rsCliente.Open "SELECT NumCliente FROM TblClienteFiat WHERE Nome = '" & Nome & "' AND" & CodCLiente = " & Numero & "", db, adOpenStatic, adLockOptimistic"

'

' If rsCliente.EOF Then

' db.Execute "INSERT INTO TblClienteFiat (CodCliente, Nome) VALUES ( " & Numero & ", '" & Nome & "')"

' Set rsCliente = New adodb.Recordset

' rsCliente.Open "SELECT NumCliente FROM TblClienteFiat WHERE Nome = '" & Nome & "' AND CodCLiente = " & Numero & " ", db, adOpenStatic, adLockOptimistic

' End If

' BuscaCodClienteFiat = rsCliente!NumCliente

' rsCliente.Close

' Set rsCliente = Nothing

End Function

Private Sub GravaTblVien(ByRef ArrayGerado As Variant, _

ByRef rsArquivo As ADODB.Recordset)

On Error GoTo Error_Handler 'Ativa a rotina de tratamento de erro

rsArquivo.AddNew

If ArrayGerado(0) = 1 Then ArrayGerado(0) = 16

If ArrayGerado(1) = "NC" Then ArrayGerado(1) = "LN"

rsArquivo("CodEstab") = ArrayGerado(0)

rsArquivo("TipoEntrega") = ArrayGerado(1)

rsArquivo("CodTipo") = BuscaCodTipo(ArrayGerado(2))

rsArquivo("Mes") = Mid(ArrayGerado(3), 1, 2)

rsArquivo("Ano") = Mid(ArrayGerado(3), 4, 4)

rsArquivo("QtdVeiculos") = IIf(ArrayGerado(4) <> "", ArrayGerado(4), 0)

rsArquivo("QtdViagens") = IIf(ArrayGerado(5) <> "", ArrayGerado(5), 0)

rsArquivo("QtdEntregas") = IIf(ArrayGerado(6) <> "", ArrayGerado(6), 0)

rsArquivo.Update

Exit Sub

Error_Handler: 'Rotina de tratamento de erro

If Err.Number = 9 Then

Resume Next

Else

Call Err.Raise(Err.Number, ErrSource("FrmImportar", "GravaTblVien()"), Err.Description, Err.HelpFile, Err.HelpContext)

End If

End Sub

Private Sub GravaTblVici(ByRef ArrayGerado As Variant, _

ByRef rsArquivo As ADODB.Recordset)

On Error GoTo Error_Handler 'Ativa a rotina de tratamento de erro

rsArquivo.AddNew

If ArrayGerado(0) = 1 Then ArrayGerado(0) = 16

If ArrayGerado(1) = "NC" Then ArrayGerado(1) = "LN"

rsArquivo("CodEstab") = ArrayGerado(0)

rsArquivo("CodTipo") = BuscaCodTipo(ArrayGerado(1))

'rsArquivo("MesAno") = Arraygerado(2)

rsArquivo("Mes") = Mid(ArrayGerado(2), 1, 2)

rsArquivo("Ano") = Mid(ArrayGerado(2), 4, 4)

rsArquivo("CodCidade") = BuscaCodCidade(ArrayGerado(3), ArrayGerado(4))

rsArquivo("TipoEntrega") = ArrayGerado(5)

rsArquivo("QtdVeiculos") = IIf(ArrayGerado(6) <> "", ArrayGerado(6), 0)

rsArquivo("QtdEntregas") = IIf(ArrayGerado(7) <> "", ArrayGerado(7), 0)

rsArquivo.Update

Exit Sub

Error_Handler: 'Rotina de tratamento de erro

If Err.Number = 9 Then

Resume Next

Else

Call Err.Raise(Err.Number, ErrSource("FrmImportar", "GravaTblVici()"), Err.Description, Err.HelpFile, Err.HelpContext)

Err.Clear

End If

End Sub

Private Sub GravaTblSada(ByRef ArrayGerado As Variant, _

ByRef rsArquivo As ADODB.Recordset)

On Error GoTo Error_Handler 'Ativa a rotina de tratamento de erro

rsArquivo.AddNew

MsgBox ArrayGerado(0)

rsArquivo("Chassi") = ArrayGerado(0)

rsArquivo("CodTipo") = BuscaCodTipo(ArrayGerado(1)) 'Acredito que o erro esteja ocorrendo aqui

rsArquivo("CodEstab") = ArrayGerado(2) 'BuscaCodEstab(ArrayGerado(2))

rsArquivo("Conhecimento") = ArrayGerado(3)

VerificaCliente ArrayGerado(4)

rsArquivo("CodCliente") = ArrayGerado(4)

rsArquivo("DtExped") = CDate(ArrayGerado(5))

rsArquivo("NotaFiscal") = ArrayGerado(6)

If ArrayGerado(7) = "" Then

rsArquivo("Frota") = 99

Else

VerificaFrota Replace(ArrayGerado(7), ".", "")

rsArquivo("Frota") = Replace(ArrayGerado(7), ".", "")

End If

rsArquivo("Km") = ArrayGerado(8)

If ArrayGerado(9) <> vbNullString Then rsArquivo("FreteSada") = CDbl(Replace(ArrayGerado(9), ".", ".")) + CDbl(Replace("0,00", ".", "."))

rsArquivo("CodCidade") = BuscaCodCidade(Replace(ArrayGerado(10), "'", "`"), Replace(ArrayGerado(11), "'", "`"))

If ArrayGerado(12) <> vbNullString Then rsArquivo("FreteTotal") = CDbl(Replace(ArrayGerado(12), ".", ".")) + CDbl(Replace("0,00", ".", "."))

If ArrayGerado(13) <> vbNullString Then rsArquivo("ICMS") = CDbl(Replace(ArrayGerado(13), ".", ".")) + CDbl(Replace("0,00", ".", "."))

If ArrayGerado(14) <> vbNullString Then rsArquivo("Seguro") = CDbl(Replace(ArrayGerado(14), ".", ".")) + CDbl(Replace("0,00", ".", "."))

If ArrayGerado(15) <> vbNullString Then rsArquivo("Pedagio") = CDbl(Replace(ArrayGerado(15), ".", ".")) + CDbl(Replace("0,00", ".", "."))

If ArrayGerado(16) <> vbNullString Then rsArquivo("ISS") = CDbl(Replace(ArrayGerado(16), ".", ".")) + CDbl(Replace("0,00", ".", "."))

If ArrayGerado(17) <> vbNullString Then rsArquivo("Desconto") = CDbl(Replace(ArrayGerado(17), ".", ".")) + CDbl(Replace("0,00", ".", "."))

rsArquivo("CodDescricao") = BuscaCodDescricao(Replace(ArrayGerado(18), "'", "`"))

rsArquivo("CodModelo") = BuscaCodModelo(Replace(ArrayGerado(19), "'", "`"))

If ArrayGerado(20) <> vbNullString Then rsArquivo("VrMercadoria") = CDbl(Replace(ArrayGerado(20), ".", ".")) + CDbl(Replace("0,00", ".", "."))

If ArrayGerado(21) <> vbNullString Then rsArquivo("Pedido") = ArrayGerado(21)

'If ArrayGerado(22) > 58 And ArrayGerado(22) < 2981 Then

' MsgBox "Tipo Servico Inexistente"

'End If

If ArrayGerado(22) = "" Then

rsArquivo("TipoServico") = 999

Else

rsArquivo("TipoServico") = ArrayGerado(22)

End If

'If ArrayGerado(22) <> vbNullString Then rsArquivo("TipoServico") = ArrayGerado(22)

If ArrayGerado(23) <> vbNullString Then rsArquivo("TipoTransporte") = ArrayGerado(23)

If ArrayGerado(24) = "" Then

'rsArquivo("CodEstabV") = "999"

rsArquivo("CodEstabV") = ArrayGerado(2)

Else

rsArquivo("CodEstabV") = ArrayGerado(24)

End If

'rsArquivo("CodEstabV") = ArrayGerado(24) 'BuscaCodEstabV(ArrayGerado(24))

If ArrayGerado(25) = "" Then

rsArquivo("Viagem") = 999

Else

rsArquivo("Viagem") = ArrayGerado(25)

End If

rsArquivo.Update

Exit Sub

Error_Handler: 'Rotina de tratamento de erro

Call Err.Raise(Err.Number, ErrSource("FrmImportar", "GravaTblSada()"), Err.Description, Err.HelpFile, Err.HelpContext)

Err.Clear

'MsgBox "Erro ao importar arquivo.", vbCritical + vbOKOnly

End Sub

Private Sub GravaTblVendaDiretaSada(ByRef ArrayGerado As Variant, _

ByRef rsArquivo As ADODB.Recordset)

On Error GoTo Error_Handler 'Ativa a rotina de tratamento de erro

rsArquivo.AddNew

rsArquivo("CodEstab") = "16"

rsArquivo("CodCidade") = BuscaCodCidade(Replace(ArrayGerado(1), "'", "`"), Replace(ArrayGerado(2), "'", "`"))

rsArquivo("Veiculos") = IIf(ArrayGerado(3) <> vbNullString, ArrayGerado(3), 0)

rsArquivo("Mes") = Mid(ArrayGerado(0), 1, 2)

rsArquivo("Ano") = Mid(ArrayGerado(0), 4, 4)

If ArrayGerado(4) <> vbNullString Then rsArquivo("VrMercadoria") = CDbl(Replace(ArrayGerado(4), ".", ","))

If ArrayGerado(5) <> vbNullString Then rsArquivo("FreteTotal") = CDbl(Replace(ArrayGerado(5), ".", ","))

If ArrayGerado(6) <> vbNullString Then rsArquivo("VeiculoFunc") = CDbl(Replace(ArrayGerado(6), ".", ","))

If ArrayGerado(7) <> vbNullString Then rsArquivo("VrMercadoriaFunc") = CDbl(Replace(ArrayGerado(7), ".", ","))

If ArrayGerado(8) <> vbNullString Then rsArquivo("FreteFunc") = CDbl(Replace(ArrayGerado(8), ".", ","))

rsArquivo.Update

Exit Sub

Error_Handler: 'Rotina de tratamento de erro

If Err.Number = 9 Then

Resume Next

Else

Call Err.Raise(Err.Number, ErrSource("FrmImportar", "GravaTblCida()"), Err.Description, Err.HelpFile, Err.HelpContext)

Err.Clear

End If

End Sub

Private Sub GravaTblVendaDiretaLocaliza(ByRef ArrayGerado As Variant, _

ByRef rsArquivo As ADODB.Recordset)

On Error GoTo Error_Handler 'Ativa a rotina de tratamento de erro

rsArquivo.AddNew

rsArquivo("CodEstab") = "16"

rsArquivo("CodCidade") = BuscaCodCidade(Replace(ArrayGerado(1), "'", "`"), Replace(ArrayGerado(2), "'", "`"))

rsArquivo("Veiculos") = ArrayGerado(3)

rsArquivo("Mes") = Mid(ArrayGerado(0), 1, 2)

rsArquivo("Ano") = Mid(ArrayGerado(0), 4, 4)

If ArrayGerado(4) <> vbNullString Then rsArquivo("VrMercadoria") = CDbl(Replace(ArrayGerado(4), ".", ","))

If ArrayGerado(5) <> vbNullString Then rsArquivo("FreteTotal") = CDbl(Replace(ArrayGerado(5), ".", ","))

rsArquivo.Update

Exit Sub

Error_Handler: 'Rotina de tratamento de erro

If Err.Number = 9 Then

Resume Next

Else

Call Err.Raise(Err.Number, ErrSource("FrmImportar", "GravaTblCida()"), Err.Description, Err.HelpFile, Err.HelpContext)

Err.Clear

End If

End Sub

Private Sub GravaTblFiat(ByRef sLinha As String, _

ByRef rsArquivo As ADODB.Recordset)

On Error GoTo Error_Handler 'Ativa a rotina de tratamento de erro

''rsArquivo.AddNew

'''Mes 01/2003

''rsArquivo("CodEstab") = BuscaCodEstab(Trim(Mid(sLinha, 4, 1)), True)

''rsArquivo("CodEstado") = BuscaCodEstado(Trim(Mid(sLinha, 5, 2)))

''rsArquivo("CodCidade") = BuscaCodCidade(Trim(Mid(sLinha, 7, 30)))

''rsArquivo("NumCliente") = BuscaCodClienteFiat(Trim(Mid(sLinha, 37, 6)), Replace(Trim(Mid(sLinha, 43, 15)), "'", "`"))

''rsArquivo("NF") = Trim(Mid(sLinha, 58, 7))

''rsArquivo("DtExped") = (Mid(sLinha, 65, 2) & "/" & Mid(sLinha, 67, 2) & "/" & Mid(sLinha, 69, 4))

''rsArquivo("Frota") = IIf(IsNumeric(Mid(sLinha, 75, 4)), Mid(sLinha, 75, 4), Null)

''rsArquivo("Chassi") = Trim(Mid(sLinha, 79, 13))

''rsArquivo("Frete") = Trim(CDbl(Replace(Mid(sLinha, 92, 7), ".", ",")))

''rsArquivo("Km") = IIf(Mid(sLinha, 99, 4) <> "", Trim(Mid(sLinha, 99, 4)), Null)

'Mes 02/2003 - 5 Caracteres a menos no nome do cliente

'rsArquivo("CodEstab") = BuscaCodEstab(Trim(Mid(sLinha, 4, 1)), True)

'rsArquivo("CodEstado") = BuscaCodEstado(Trim(Mid(sLinha, 5, 2)))

'rsArquivo("CodCidade") = BuscaCodCidade(Trim(Mid(sLinha, 7, 25)))

'rsArquivo("NumCliente") = BuscaCodClienteFiat(Trim(Mid(sLinha, 32, 6)), Replace(Trim(Mid(sLinha, 38, 15)), "'", "`"))

'rsArquivo("NF") = Trim(Mid(sLinha, 53, 7))

'rsArquivo("DtExped") = (Mid(sLinha, 60, 2) & "/" & Mid(sLinha, 62, 2) & "/" & Mid(sLinha, 64, 4))

'rsArquivo("Frota") = IIf(IsNumeric(Mid(sLinha, 70, 4)), Mid(sLinha, 70, 4), Null)

'rsArquivo("Chassi") = Trim(Mid(sLinha, 74, 13))

'rsArquivo("Frete") = Trim(CDbl(Replace(Mid(sLinha, 87, 7), ".", ",")))

'rsArquivo("Km") = IIf(Mid(sLinha, 99, 4) <> "", Trim(Mid(sLinha, 99, 4)), Null)

'''' rsArquivo.Update

Exit Sub

Error_Handler: 'Rotina de tratamento de erro

Call Err.Raise(Err.Number, ErrSource("FrmImportar", "GravaTblFiat()"), Err.Description, Err.HelpFile, Err.HelpContext)

Err.Clear

End Sub

Private Sub GravaTblConc(ByRef ArrayGerado As Variant, _

ByRef rsArquivo As ADODB.Recordset)

On Error GoTo Error_Handler 'Ativa a rotina de tratamento de erro

rsArquivo.AddNew

If ArrayGerado(0) = 1 Then ArrayGerado(0) = 16

If ArrayGerado(1) = "NC" Then ArrayGerado(1) = "LN"

rsArquivo("CodEstab") = ArrayGerado(0)

rsArquivo("CodTipo") = BuscaCodTipo(ArrayGerado(1))

'rsArquivo("MesAno") = Arraygerado(2)

rsArquivo("Mes") = Mid(ArrayGerado(2), 1, 2)

rsArquivo("Ano") = Mid(ArrayGerado(2), 4, 4)

rsArquivo("Cliente") = Replace(ArrayGerado(3), "'", "")

rsArquivo("CodCidade") = BuscaCodCidade(Replace(ArrayGerado(4), "'", ""), Replace(ArrayGerado(5), "'", ""))

rsArquivo("Km") = IIf(ArrayGerado(6) <> "", ArrayGerado(6), 0)

rsArquivo("VeicCliOU") = IIf(ArrayGerado(7) <> "", ArrayGerado(7), 0)

rsArquivo("VeicCliEX") = IIf(ArrayGerado(8) <> "", ArrayGerado(8), 0)

rsArquivo("VeicCliVD") = IIf(ArrayGerado(9) <> "", ArrayGerado(9), 0)

rsArquivo("VeicCliLO") = IIf(ArrayGerado(10) <> "", ArrayGerado(10), 0)

rsArquivo("VeicCliLN") = IIf(ArrayGerado(11) <> "", ArrayGerado(11), 0)

rsArquivo("VeicCliPU") = IIf(ArrayGerado(12) <> "", ArrayGerado(12), 0)

rsArquivo("VeicCliFU") = IIf(ArrayGerado(13) <> "", ArrayGerado(13), 0)

rsArquivo("VeicCliRF") = IIf(ArrayGerado(14) <> "", ArrayGerado(14), 0)

rsArquivo("VeicCliPA") = IIf(ArrayGerado(15) <> "", ArrayGerado(15), 0)

rsArquivo("VeicCliPG") = IIf(ArrayGerado(16) <> "", ArrayGerado(16), 0)

rsArquivo.Update

Exit Sub

Error_Handler: 'Rotina de tratamento de erro

If Err.Number = 9 Then

Resume Next

Else

Call Err.Raise(Err.Number, ErrSource("FrmImportar", "GravaTblConc()"), Err.Description, Err.HelpFile, Err.HelpContext)

Err.Clear

End If

End Sub

Private Sub GravaTblFtfa(ByRef ArrayGerado As Variant, _

ByRef rsArquivo As ADODB.Recordset)

On Error GoTo Error_Handler 'Ativa a rotina de tratamento de erro

rsArquivo.AddNew

If ArrayGerado(0) = 1 Then ArrayGerado(0) = 16

If ArrayGerado(1) = "NC" Then ArrayGerado(1) = "LN"

rsArquivo("CodEstab") = ArrayGerado(0)

rsArquivo("CodTipo") = BuscaCodTipo(ArrayGerado(1))

'rsArquivo("MesAno") = Arraygerado(2)

rsArquivo("Mes") = Mid(ArrayGerado(2), 1, 2)

rsArquivo("Ano") = Mid(ArrayGerado(2), 4, 4)

rsArquivo("QtdVeiculos") = IIf(ArrayGerado(3) <> "", ArrayGerado(3), 0)

rsArquivo("FretePuro") = IIf(ArrayGerado(4) <> "", Replace(ArrayGerado(4), ".", ","), 0)

rsArquivo("ICMS") = IIf(ArrayGerado(5) <> "", Replace(ArrayGerado(5), ".", ","), 0)

rsArquivo("Seguro") = IIf(ArrayGerado(6) <> "", Replace(ArrayGerado(6), ".", ","), 0)

rsArquivo("Pedagio") = IIf(ArrayGerado(7) <> "", Replace(ArrayGerado(7), ".", ","), 0)

rsArquivo("ISS") = IIf(ArrayGerado(8) <> "", Replace(ArrayGerado(8), ".", ","), 0)

rsArquivo("KmCobrado") = IIf(ArrayGerado(9) <> "", ArrayGerado(9), 0)

rsArquivo("KmMaior") = IIf(ArrayGerado(10) <> "", ArrayGerado(10), 0)

rsArquivo("ValorMercado") = IIf(ArrayGerado(11) <> "", Replace(ArrayGerado(11), ".", ","), 0)

rsArquivo.Update

Exit Sub

Error_Handler: 'Rotina de tratamento de erro

If Err.Number = 9 Then

Resume Next

Else

Call Err.Raise(Err.Number, ErrSource("FrmImportar", "GravaTblFtfa()"), Err.Description, Err.HelpFile, Err.HelpContext)

Err.Clear

End If

End Sub

Private Sub ContMensagemStatus(ByRef Linhas As Long) ', ByRef ArrayGerado As Variant)

On Error GoTo Error_Handler 'Ativa a rotina de tratamento de erro

lblMsg1 = "Importando registro " & Linhas - 1 & " de " & linhasTxt - 1 & ", aguarde a conclusão..." '& ArrayGerado(0)

ProgressBar1.Value = ProgressBar1.Value + 1

Exit Sub

Error_Handler: 'Rotina de tratamento de erro

Call Err.Raise(Err.Number, ErrSource("FrmImportar", "ContMensagemStatus()"), Err.Description, Err.HelpFile, Err.HelpContext)

Err.Clear

End Sub

Private Sub ImportaArquivoSada(ByVal rsArquivo As ADODB.Recordset)

'On Error GoTo Error_Handler 'Ativa a rotina de tratamento de erro

Dim sLinha As String

Dim ArrayGerado As Variant

Dim Linhas As Long

Linhas = 1

Open txtArquivo For Input As #1

If Not EOF(1) Then Line Input #1, sLinha 'Passa primeira linha e desconsidera cabecalho

Do While Not EOF(1)

DoEvents

If bParar = True Then Exit Sub 'força a saída da rotina quando pressionado "Cancelar"

Line Input #1, sLinha

ContMensagemStatus Linhas

ArrayGerado = Split(sLinha, ";", -1)

GravaTblSada ArrayGerado, rsArquivo

Linhas = Linhas + 1

Loop

Close #1

Exit Sub

MsgBox "Arquivo Importado", vbInformation + vbOKOnly

Error_Handler: 'Rotina de tratamento de erro

'Call Err.Raise(Err.Number, ErrSource("FrmImportar", "ImportaArquivoSada()"), Err.Description, Err.HelpFile, Err.HelpContext)

'Err.Clear

Resume Next

MsgBox "Importação efetuada com sucesso.", vbOKOnly + vbInformation, "SCEV"

End Sub

Private Function BuscaCodModelo(ByVal Modelo As String) As Integer

On Error GoTo Error_Handler 'Ativa a rotina de tratamento de erro

Dim rsModelo As ADODB.Recordset

If Modelo = "" Or Modelo = "." Then Modelo = "Não informado"

Set rsModelo = New ADODB.Recordset

rsModelo.Open "SELECT CodModelo From TblModelo WHERE Modelo = '" & Modelo & "'", db, adOpenStatic, adLockOptimistic

If rsModelo.EOF Then

db.Execute "INSERT INTO TblModelo (Modelo) VALUES ('" & Modelo & "')"

Set rsModelo = New ADODB.Recordset

rsModelo.Open "SELECT CodModelo From TblModelo WHERE Modelo = '" & Modelo & "'", db, adOpenStatic, adLockOptimistic

End If

BuscaCodModelo = rsModelo!CodModelo

rsModelo.Close

Set rsModelo = Nothing

Exit Function

Error_Handler: 'Rotina de tratamento de erro

Call Err.Raise(Err.Number, ErrSource("FrmImportar", "BuscaCodModelo()"), Err.Description, Err.HelpFile, Err.HelpContext)

Err.Clear

End Function

Private Function BuscaCodDescricao(ByVal Descricao As String) As Integer

On Error GoTo Error_Handler 'Ativa a rotina de tratamento de erro

Dim rsDescricao As ADODB.Recordset

If Descricao = "" Or Descricao = "." Then Descricao = "Não informada"

Set rsDescricao = New ADODB.Recordset

rsDescricao.Open "SELECT CodDescricao From TblDescricao WHERE Descricao = '" & Descricao & "'", db, adOpenStatic, adLockOptimistic

If rsDescricao.EOF Then

db.Execute "INSERT INTO TblDescricao (Descricao) VALUES ('" & Descricao & "')"

Set rsDescricao = New ADODB.Recordset

rsDescricao.Open "SELECT CodDescricao From TblDescricao WHERE Descricao = '" & Descricao & "'", db, adOpenStatic, adLockOptimistic

End If

BuscaCodDescricao = rsDescricao!CodDescricao

rsDescricao.Close

Set rsDescricao = Nothing

Exit Function

Error_Handler: 'Rotina de tratamento de erro

Call Err.Raise(Err.Number, ErrSource("FrmImportar", "BuscaCodDescricao()"), Err.Description, Err.HelpFile, Err.HelpContext)

Err.Clear

End Function

Private Sub GravaTblVico(ByRef ArrayGerado As Variant, _

ByRef rsArquivo As ADODB.Recordset)

On Error GoTo Error_Handler 'Ativa a rotina de tratamento de erro

rsArquivo.AddNew

If ArrayGerado(0) = 1 Then ArrayGerado(0) = 16

If ArrayGerado(1) = "NC" Then ArrayGerado(1) = "LN"

rsArquivo("CodEstab") = ArrayGerado(0)

rsArquivo("CodTipo") = BuscaCodTipo(ArrayGerado(1))

'rsArquivo("MesAno") = Arraygerado(2)

rsArquivo("Mes") = Mid(ArrayGerado(2), 1, 2)

rsArquivo("Ano") = Mid(ArrayGerado(2), 4, 4)

VerificaCliente ArrayGerado(3)

rsArquivo("CodCliente") = ArrayGerado(3)

rsArquivo("TipoEntrega") = ArrayGerado(4)

rsArquivo("QtdVeiculos") = IIf(ArrayGerado(5) <> "", ArrayGerado(6), 0)

rsArquivo("QtdEntregas") = IIf(ArrayGerado(6) <> "", ArrayGerado(6), 0)

rsArquivo.Update

Exit Sub

Error_Handler: 'Rotina de tratamento de erro

If Err.Number = 9 Then

Resume Next

Else

Call Err.Raise(Err.Number, ErrSource("FrmImportar", "GravaTblVico()"), Err.Description, Err.HelpFile, Err.HelpContext)

Err.Clear

End If

End Sub

Private Sub GravaTblViuf(ByRef ArrayGerado As Variant, _

ByRef rsArquivo As ADODB.Recordset)

On Error GoTo Error_Handler 'Ativa a rotina de tratamento de erro

rsArquivo.AddNew

If ArrayGerado(0) = 1 Then ArrayGerado(0) = 16

If ArrayGerado(1) = "NC" Then ArrayGerado(1) = "LN"

rsArquivo("CodEstab") = ArrayGerado(0)

rsArquivo("CodTipo") = BuscaCodTipo(ArrayGerado(1))

'rsArquivo("MesAno") = Arraygerado(2)

rsArquivo("Mes") = Mid(ArrayGerado(2), 1, 2)

rsArquivo("Ano") = Mid(ArrayGerado(2), 4, 4)

rsArquivo("CodEstado") = BuscaCodEstado(ArrayGerado(3))

rsArquivo("TipoEntrega") = ArrayGerado(4)

rsArquivo("QtdVeiculos") = IIf(ArrayGerado(5) <> "", ArrayGerado(5), 0)

rsArquivo("QtdEntregas") = IIf(ArrayGerado(6) <> "", ArrayGerado(6), 0)

rsArquivo.Update

Exit Sub

Error_Handler: 'Rotina de tratamento de erro

If Err.Number = 9 Then

Resume Next

Else

Call Err.Raise(Err.Number, ErrSource("FrmImportar", "GravaTblViuf()"), Err.Description, Err.HelpFile, Err.HelpContext)

Err.Clear

End If

End Sub

Private Sub GravaTblCida(ByRef ArrayGerado As Variant, _

ByRef rsArquivo As ADODB.Recordset)

On Error GoTo Error_Handler 'Ativa a rotina de tratamento de erro

rsArquivo.AddNew

If ArrayGerado(0) = 1 Then ArrayGerado(0) = 16

If ArrayGerado(1) = "NC" Then ArrayGerado(1) = "LN"

rsArquivo("CodEstab") = ArrayGerado(0)

rsArquivo("CodTipo") = BuscaCodTipo(ArrayGerado(1))

rsArquivo("Mes") = Mid(ArrayGerado(2), 1, 2)

rsArquivo("Ano") = Mid(ArrayGerado(2), 4, 4)

'rsArquivo("MesAno") = Arraygerado(2)

rsArquivo("CodCidade") = BuscaCodCidade(Replace(ArrayGerado(3), "'", "`"), Replace(ArrayGerado(4), "'", "`"))

rsArquivo("Km") = IIf(ArrayGerado(5) <> "", ArrayGerado(5), 0)

rsArquivo("VeicCidOU") = IIf(ArrayGerado(6) <> "", ArrayGerado(6), 0)

rsArquivo("VeicCidEX") = IIf(ArrayGerado(7) <> "", ArrayGerado(7), 0)

rsArquivo("VeicCidVD") = IIf(ArrayGerado(8) <> "", ArrayGerado(8), 0)

rsArquivo("VeicCidLO") = IIf(ArrayGerado(9) <> "", ArrayGerado(9), 0)

rsArquivo("VeicCidLN") = IIf(ArrayGerado(10) <> "", ArrayGerado(10), 0)

rsArquivo("VeicCidPU") = IIf(ArrayGerado(11) <> "", ArrayGerado(11), 0)

rsArquivo("VeicCidFU") = IIf(ArrayGerado(12) <> "", ArrayGerado(12), 0)

rsArquivo("VeicCidRF") = IIf(ArrayGerado(13) <> "", ArrayGerado(13), 0)

rsArquivo("VeicCidPA") = IIf(ArrayGerado(14) <> "", ArrayGerado(14), 0)

rsArquivo("VeicCidPG") = IIf(ArrayGerado(15) <> "", ArrayGerado(15), 0)

rsArquivo.Update

Exit Sub

Error_Handler: 'Rotina de tratamento de erro

If Err.Number = 9 Then

Resume Next

Else

Call Err.Raise(Err.Number, ErrSource("FrmImportar", "GravaTblCida()"), Err.Description, Err.HelpFile, Err.HelpContext)

Err.Clear

End If

End Sub

Private Sub ImportaOutrosArquivos(ByRef rsArquivo As ADODB.Recordset, ByVal Tabela As String)

On Error GoTo Error_Handler 'Ativa a rotina de tratamento de erro

Dim sLinha As String

Dim ArrayGerado As Variant

Dim Linhas As Long

Linhas = 1

Open txtArquivo For Input As #1

If Not EOF(1) Then Line Input #1, sLinha 'Desconsidera primeira linha

Do While Not EOF(1)

DoEvents

If bParar Then Exit Sub

Linhas = Linhas + 1

Line Input #1, sLinha

ContMensagemStatus Linhas

ArrayGerado = Split(sLinha, ";", -1)

Select Case Tabela

Case "TBLCIDA": GravaTblCida ArrayGerado, rsArquivo

Case "TBLCONC": GravaTblConc ArrayGerado, rsArquivo

Case "TBLVICI": GravaTblVici ArrayGerado, rsArquivo

Case "TBLVIEN": GravaTblVien ArrayGerado, rsArquivo

Case "TBLVICO": GravaTblVico ArrayGerado, rsArquivo

Case "TBLVIUF": GravaTblViuf ArrayGerado, rsArquivo

Case "TBLFTFA": GravaTblFtfa ArrayGerado, rsArquivo

Case "TBLKMFROTA": GravaTblKmFr ArrayGerado, rsArquivo

End Select

Loop

Close #1

Exit Sub

Error_Handler: 'Rotina de tratamento de erro

Call Err.Raise(Err.Number, ErrSource("FrmImportar", "ImportaArquivoTxtOutrosArq()"), Err.Description, Err.HelpFile, Err.HelpContext)

Err.Clear

End Sub

Private Sub GravaTblKmFr(ByRef ArrayGerado As Variant, ByRef rsArquivo As ADODB.Recordset)

On Error GoTo Error_Handler 'Ativa a rotina de tratamento de erro

Dim rsaux As ADODB.Recordset

Dim sSQL As String

If ArrayGerado(0) = 1 Then ArrayGerado(0) = 16

If ArrayGerado(2) = "NC" Then ArrayGerado(2) = "LN"

Select Case ArrayGerado(1)

Case "1000": ArrayGerado(1) = "NOR"

Case "21000": ArrayGerado(1) = "TEG"

End Select

If ArrayGerado(1) = "TEG" Or ArrayGerado(1) = "NOR" Then

sSQL = "SELECT TblKmFrota.CodEstab, TblKmFrota.CodTipoFrota, TblKmFrota.CodTipo, TblKmFrota.Mes, TblKmFrota.Ano, TblKmFrota.KMCobrado, TblKmFrota.KmMaior, TblKmFrota.QteVeiculos"

sSQL = sSQL & " FROM TblTipoFrota INNER JOIN (TblTipoServico INNER JOIN TblKmFrota ON TblTipoServico.CodTipo = TblKmFrota.CodTipo) ON TblTipoFrota.CodTipoFrota = TblKmFrota.CodTipoFrota"

sSQL = sSQL & " WHERE TblKmFrota.CodEstab=" & ArrayGerado(0) & " AND TblTipoServico.SiglaTipo= '" & ArrayGerado(2) & "' AND TblTipoFrota.TipoFrota= '" & ArrayGerado(1) & "' AND TblKmFrota.Mes=" & Mid(ArrayGerado(3), 1, 2) & " AND TblKmFrota.Ano=" & Mid(ArrayGerado(3), 4, 4) & ";"

Set rsaux = New ADODB.Recordset

rsaux.Open sSQL, db, adOpenStatic, adLockOptimistic

If Not rsaux.EOF Then

rsaux("CodEstab") = ArrayGerado(0)

rsaux("CodTipoFrota") = BuscaCodTipoFrota(ArrayGerado(1))

rsaux("CodTipo") = BuscaCodTipo(ArrayGerado(2))

rsaux("Mes") = Mid(ArrayGerado(3), 1, 2)

rsaux("Ano") = Mid(ArrayGerado(3), 4, 4)

rsaux("KmCobrado") = ArrayGerado(4) + rsaux("KmCobrado")

rsaux("KmMaior") = ArrayGerado(6) + rsaux("KmMaior")

rsaux("QteVeiculos") = ArrayGerado(5) + rsaux("QteVeiculos")

Else

rsaux.AddNew

rsaux("CodEstab") = ArrayGerado(0)

rsaux("CodTipoFrota") = BuscaCodTipoFrota(ArrayGerado(1))

rsaux("CodTipo") = BuscaCodTipo(ArrayGerado(2))

rsaux("Mes") = Mid(ArrayGerado(3), 1, 2)

rsaux("Ano") = Mid(ArrayGerado(3), 4, 4)

rsaux("KmCobrado") = ArrayGerado(4)

rsaux("KmMaior") = ArrayGerado(6)

rsaux("QteVeiculos") = ArrayGerado(5)

End If

rsaux.Update

rsaux.Close

Set rsaux = Nothing

Else

rsArquivo.AddNew

rsArquivo("CodEstab") = ArrayGerado(0)

rsArquivo("CodTipoFrota") = BuscaCodTipoFrota(ArrayGerado(1))

rsArquivo("CodTipo") = BuscaCodTipo(ArrayGerado(2))

rsArquivo("Mes") = Mid(ArrayGerado(3), 1, 2)

rsArquivo("Ano") = Mid(ArrayGerado(3), 4, 4)

rsArquivo("KmCobrado") = ArrayGerado(4)

rsArquivo("KmMaior") = ArrayGerado(6)

rsArquivo("QteVeiculos") = ArrayGerado(5)

End If

Exit Sub

Error_Handler: 'Rotina de tratamento de erro

If Err.Number = 9 Then

Resume Next

Else

Call Err.Raise(Err.Number, ErrSource("FrmImportar", "GravaTblKmFr()"), Err.Description, Err.HelpFile, Err.HelpContext)

Err.Clear

End If

End Sub

Private Function BuscaCodTipoFrota(ByVal Frota As String) As Integer

On Error GoTo Error_Handler 'Ativa a rotina de tratamento de erro

Dim rsFrota As ADODB.Recordset

Set rsFrota = New ADODB.Recordset

rsFrota.Open "SELECT CodTipoFrota From TblTipoFrota WHERE TipoFrota= '" & Frota & "'", db, adOpenStatic, adLockOptimistic

If rsFrota.EOF Then

db.Execute "INSERT INTO TblTipoFrota (TipoFrota) VALUES ( '" & Frota & "')"

Set rsFrota = New ADODB.Recordset

rsFrota.Open "SELECT CodTipoFrota From TblTipoFrota WHERE TipoFrota= '" & Frota & "'", db, adOpenStatic, adLockOptimistic

End If

BuscaCodTipoFrota = rsFrota!CodTipoFrota

rsFrota.Close

Set rsFrota = Nothing

Exit Function

Error_Handler: 'Rotina de tratamento de erro

Call Err.Raise(Err.Number, ErrSource("FrmImportar", "BuscaCodTipoFrota()"), Err.Description, Err.HelpFile, Err.HelpContext)

Err.Clear

End Function

Private Sub VerificaCliente(ByVal Cliente As String)

On Error GoTo Error_Handler 'Ativa a rotina de tratamento de erro

Dim rsCliente As ADODB.Recordset

Set rsCliente = New ADODB.Recordset

rsCliente.Open "SELECT * FROM TblClienteSada WHERE CodCLiente = " & "'" & Cliente & "'", db, adOpenStatic, adLockOptimistic

If rsCliente.EOF Then

rsCliente.AddNew

rsCliente!CodCliente = Cliente

rsCliente.Update

End If

rsCliente.Close

Set rsCliente = Nothing

Exit Sub

Error_Handler: 'Rotina de tratamento de erro

Call Err.Raise(Err.Number, ErrSource("FrmImportar", "VerificaCliente()"), Err.Description, Err.HelpFile, Err.HelpContext)

Err.Clear

End Sub

Private Sub VerificaFrota(ByVal Frota As Integer)

On Error GoTo Error_Handler 'Ativa a rotina de tratamento de erro

Dim rsFrota As ADODB.Recordset

Set rsFrota = New ADODB.Recordset

rsFrota.Open "SELECT * FROM TblFrota WHERE NumFrota = " & "" & Frota & "", db, adOpenStatic, adLockOptimistic

If rsFrota.EOF Then

rsFrota.AddNew

If Frota = 1000 Then

rsFrota!CodTipoFrota = 6

ElseIf Frota = 21000 Then

rsFrota!CodTipoFrota = 10

ElseIf Frota = 2921 Or Frota = 2926 Or Frota = 2927 Then

rsFrota!CodTipoFrota = 8

ElseIf Frota = 28000 Then

rsFrota!CodTipoFrota = 9

ElseIf Frota > 1000 And Frota < 1200 Then

rsFrota!CodTipoFrota = 8

ElseIf Frota > 9999 And Frota < 30001 Then

rsFrota!CodTipoFrota = 10

ElseIf Frota > 1199 And Frota < 2900 Then

rsFrota!CodTipoFrota = 6

ElseIf Frota > 200 And Frota < 901 Then

rsFrota!CodTipoFrota = 9

ElseIf Frota > 8999 And Frota < 10000 Then

rsFrota!CodTipoFrota = 5

ElseIf Frota > 3000 And Frota < 4000 Then

rsFrota!CodTipoFrota = 8

ElseIf Frota > 99 And Frota < 200 Then

rsFrota!CodTipoFrota = 4

ElseIf Frota > 2899 And Frota < 3001 Then

rsFrota!CodTipoFrota = 2

Else

rsFrota!CodTipoFrota = 7

End If

rsFrota!NumFrota = Frota

rsFrota.Update

End If

rsFrota.Close

Set rsFrota = Nothing

Exit Sub

Error_Handler: 'Rotina de tratamento de erro

Call Err.Raise(Err.Number, ErrSource("FrmImportar", "VerificaFrota()"), Err.Description, Err.HelpFile, Err.HelpContext)

Err.Clear

Resume

End Sub

Private Function BuscaCodCliente(ByVal Cliente As String) As Integer

On Error GoTo Error_Handler 'Ativa a rotina de tratamento de erro

Dim rsCliente As ADODB.Recordset

Set rsCliente = New ADODB.Recordset

rsCliente.Open "SELECT CodCliente FROM TblClienteSada WHERE Cliente = '" & Cliente & "'", db, adOpenStatic, adLockOptimistic

If rsCliente.EOF Then

db.Execute "INSERT INTO TblClienteSada (Cliente) VALUES ( '" & Cliente & "')"

Set rsCliente = New ADODB.Recordset

rsCliente.Open "SELECT CodCliente FROM TblClienteSada WHERE Cliente = '" & Cliente & "'", db, adOpenStatic, adLockOptimistic

End If

BuscaCodCliente = rsCliente!CodCliente

rsCliente.Close

Set rsCliente = Nothing

Exit Function

Error_Handler: 'Rotina de tratamento de erro

Call Err.Raise(Err.Number, ErrSource("FrmImportar", "BuscaCodCliente()"), Err.Description, Err.HelpFile, Err.HelpContext)

Err.Clear

End Function

Private Function BuscaCodTipo(ByVal Tipo As String) As Integer

On Error GoTo Error_Handler 'Ativa a rotina de tratamento de erro

Dim rsTipo As ADODB.Recordset

Set rsTipo = New ADODB.Recordset

rsTipo.Open "SELECT CodTipo FROM TblTipoServico WHERE DescTipo = '" & Tipo & "'", db, adOpenStatic, adLockOptimistic

If rsTipo.EOF Then

db.Execute "INSERT INTO TblTipoServico (SiglaTipo) VALUES ( '" & Tipo & "')"

Set rsTipo = New ADODB.Recordset

rsTipo.Open "SELECT CodTipo FROM TblTipoServico WHERE DescTipo = '" & Tipo & "'", db, adOpenStatic, adLockOptimistic

End If

BuscaCodTipo = rsTipo!CodTipo

rsTipo.Close

Set rsTipo = Nothing

Exit Function

Error_Handler: 'Rotina de tratamento de erro

Call Err.Raise(Err.Number, ErrSource("FrmImportar", "BuscaCodTipo()"), Err.Description, Err.HelpFile, Err.HelpContext)

Err.Clear

End Function

Private Function BuscaCodCidade(ByVal Cidade As String, ByVal Estado As String) As Integer

On Error GoTo Error_Handler 'Ativa a rotina de tratamento de erro

Dim CodEstado As Integer

Dim rsCidade As ADODB.Recordset

If Cidade = vbNullString Or Cidade = "." Then Cidade = "Não informada"

CodEstado = BuscaCodEstado(Estado)

Set rsCidade = New ADODB.Recordset

rsCidade.Open "SELECT CodCidade From TblCidade WHERE CodEstado = " & CodEstado & " AND DescCidade = '" & Cidade & "'", db, adOpenStatic, adLockOptimistic

If rsCidade.EOF Then

db.Execute "INSERT INTO TblCidade (CodEstado, DescCidade) VALUES (" & CodEstado & ",'" & Cidade & "')"

Set rsCidade = New ADODB.Recordset

rsCidade.Open "SELECT CodCidade From TblCidade WHERE CodEstado = " & CodEstado & " AND DescCidade = '" & Cidade & "'", db, adOpenStatic, adLockOptimistic

End If

BuscaCodCidade = rsCidade!CodCidade

rsCidade.Close

Set rsCidade = Nothing

Exit Function

Error_Handler: 'Rotina de tratamento de erro

Call Err.Raise(Err.Number, ErrSource("FrmImportar", "BuscaCodCidade()"), Err.Description, Err.HelpFile, Err.HelpContext)

Err.Clear

End Function

Private Function BuscaCodEstado(ByVal Estado As String) As Integer

On Error GoTo Error_Handler 'Ativa a rotina de tratamento de erro

Dim rsEstado As ADODB.Recordset

If Estado = vbNullString Or Estado = "." Then Estado = "Não informado"

Set rsEstado = New ADODB.Recordset

If Not (optTipo(10) Or optTipo(11)) Then

rsEstado.Open "SELECT CodEstado From TblEstado WHERE SiglaEstado = '" & Estado & "'", db, adOpenStatic, adLockOptimistic

If rsEstado.EOF Then

db.Execute "INSERT INTO TblEstado (SiglaEstado) VALUES ('" & Estado & "')"

Set rsEstado = New ADODB.Recordset

rsEstado.Open "SELECT CodEstado From TblEstado WHERE SiglaEstado = '" & Estado & "'", db, adOpenStatic, adLockOptimistic

End If

Else

rsEstado.Open "SELECT CodEstado From TblEstado WHERE SiglaEstado = '" & Estado & "'", db, adOpenStatic, adLockOptimistic

If rsEstado.EOF Then

db.Execute "INSERT INTO TblEstado (SiglaEstado) VALUES ('" & Estado & "')"

Set rsEstado = New ADODB.Recordset

rsEstado.Open "SELECT CodEstado From TblEstado WHERE SiglaEstado = '" & Estado & "'", db, adOpenStatic, adLockOptimistic

End If

End If

BuscaCodEstado = rsEstado!CodEstado

rsEstado.Close

Set rsEstado = Nothing

Exit Function

Error_Handler: 'Rotina de tratamento de erro

Call Err.Raise(Err.Number, ErrSource("FrmImportar", "BuscaCodEstado()"), Err.Description, Err.HelpFile, Err.HelpContext)

Err.Clear

End Function

Private Function BuscaCodEstab(ByVal Estab As String, Optional ByVal SiglaFiat As Boolean) As Integer

On Error GoTo Error_Handler 'Ativa a rotina de tratamento de erro

Dim rsEstab As ADODB.Recordset

Set rsEstab = New ADODB.Recordset

If Not SiglaFiat Then

rsEstab.Open ("SELECT CodEstab FROM TblEstabelecimento WHERE CodEstab = '" & Estab & "'"), db, adOpenStatic, adLockOptimistic

If rsEstab.EOF Then

Set rsEstab = New ADODB.Recordset

rsEstab.Open ("SELECT Max(CodEstab) AS MaiorCodEstab FROM TblEstabelecimento;"), db, adOpenStatic, adLockOptimistic

db.Execute ("INSERT INTO TblEstabelecimento (CodEstab, SiglaEstab ) VALUES (" & rsEstab!MaiorCodEstab + 1 & ", '" & Estab & "')")

Set rsEstab = New ADODB.Recordset

rsEstab.Open ("SELECT CodEstab FROM TblEstabelecimento WHERE SiglaEstab = '" & Estab & "'"), db, adOpenStatic, adLockOptimistic

End If

Else

rsEstab.Open ("SELECT CodEstab FROM TblEstabelecimento WHERE SiglaFiat = '" & Estab & "'"), db, adOpenStatic, adLockOptimistic

If rsEstab.EOF Then

Set rsEstab = New ADODB.Recordset

rsEstab.Open ("SELECT Max(CodEstab) AS MaiorCodEstab FROM TblEstabelecimento"), db, adOpenStatic, adLockOptimistic

db.Execute ("INSERT INTO TblEstabelecimento ( CodEstab, SiglaFiat ) VALUES ( " & rsEstab!MaiorCodEstab + 1 & ", '" & Estab & "')")

Set rsEstab = New ADODB.Recordset

rsEstab.Open ("SELECT CodEstab FROM TblEstabelecimento WHERE SiglaFiat = '" & Estab & "'"), db, adOpenStatic, adLockOptimistic

End If

End If

BuscaCodEstab = rsEstab!CodEstab

rsEstab.Close

Set rsEstab = Nothing

Exit Function

Error_Handler: 'Rotina de tratamento de erro

Call Err.Raise(Err.Number, ErrSource("FrmImportar", "BuscaCodEstab()"), Err.Description, Err.HelpFile, Err.HelpContext)

Err.Clear

End Function

Private Sub ValidaArqFiat()

''Dim rsControle As ADODB.Recordset

'

'If UCase(Dir(txtArquivo)) <> UCase("Fiat" & Format(DTArquivo, "mm") & Format(DTArquivo, "yy") & ".txt") Then

' MsgBox "O nome do arquivo não confere com os dados informados." & vbLf & "Para o mês " & Format(DTArquivo, "mm") & "/" & Year(DTArquivo) & " selecione o arquivo" & " Fiat" & Format(DTArquivo, "mm") & Format(DTArquivo, "yy") & ".txt !", vbQuestion, "Importar arquivo mensal da Fiat"

' Exit Sub

'End If

'

''Set rsControle = New ADODB.Recordset

''rsControle.Open "SELECT Mes, Ano FROM TblContImportacao WHERE TblContImportacao.Mes = " & Month(DTArquivo) & " AND TblContImportacao.Ano = " & Year(DTArquivo) & " AND Origem = 2;", db, adOpenStatic, adLockOptimistic

''If rsControle.RecordCount > 0 Then

'' MsgBox "Os registros da Fiat - Mês " & Format(DTArquivo, "mm") & "/" & Format(DTArquivo, "yyyy") & " já foram importados." & vbLf & "e não será possível importá-los novamente !", vbInformation, "Importação cancelada"

'' Exit Sub

''End If

'

'Me.MousePointer = 13

'LeArquivoTexto

'ImportarArquivoTxtFiat

End Sub

Private Function ValidaBanco() As Boolean

'Verifica se arquivo selecionado já foi importado

On Error GoTo Error_Handler 'Ativa a rotina de tratamento de erro

Dim rsArquivo As ADODB.Recordset

Set rsArquivo = New ADODB.Recordset

rsArquivo.Open "SELECT * FROM TblContImportacao WHERE NomeArquivo = '" & txtArquivo & "'", db, adOpenStatic, adLockOptimistic

If Not rsArquivo.EOF Then

MsgBox "O arquivo " & txtArquivo & " já foi importado em " & rsArquivo!DataImportacao & "." & vbLf & "Não será possível importá-lo novamente!", vbInformation + vbOKOnly

ValidaBanco = False

Else

ValidaBanco = True

End If

rsArquivo.Close

Set rsArquivo = Nothing

Exit Function

Error_Handler: 'Rotina de tratamento de erro

Call Err.Raise(Err.Number, ErrSource("FrmImportar", "VerificaBanco()"), Err.Description, Err.HelpFile, Err.HelpContext)

Err.Clear

Resume

End Function

Private Function ValidaSelecao() As Boolean

On Error GoTo Error_Handler 'Ativa a rotina de tratamento de erro

If IsNull(txtArquivo) Then 'Verifica se foi informado arquivo

MsgBox "Selecione o arquivo que deve ser importado!", vbInformation + vbOKOnly

ValidaSelecao = False

Exit Function

End If

If Not (optTipo(0) Or optTipo(1) Or optTipo(2) Or optTipo(3) Or optTipo(4) Or optTipo(5) Or optTipo(6) Or optTipo(7) Or optTipo(8) Or optTipo(9) Or optTipo(10) Or optTipo(11)) Then

MsgBox "Selecione a origem do arquivo que será importado!", vbInformation, "Importar arquivo mensal"

ValidaSelecao = False

Exit Function

End If

ValidaSelecao = True

Exit Function

Error_Handler: 'Rotina de tratamento de erro

Call Err.Raise(Err.Number, ErrSource("FrmImportar", "ValidaSelecao()"), Err.Description, Err.HelpFile, Err.HelpContext)

Err.Clear

End Function

Private Sub CmdImportar_Click()

'On Error GoTo Error_Handler 'Ativa a rotina de tratamento de erro

bParar = False

If Not ValidaSelecao Then Exit Sub

If Not ValidaDtArquivo Then Exit Sub

If Not ValidaNomeArquivo Then Exit Sub

If Not ValidaBanco Then Exit Sub

ContProgressoBotoes True

If Not LeArquivoTexto Then Exit Sub

ContIniciaBarraProgressso

If Not SelecionaArquivos Then Exit Sub

If Not FinalizaImportacao Then Exit Sub

ContProgressoBotoes False

Exit Sub

Error_Handler: 'Rotina de tratamento de erro

'Call ExibirMsgErro(mcstrNomeModulo, "cmdImportar_Click()")

'Err.Clear

bParar = True

FinalizaImportacao

ContProgressoBotoes False

End Sub

Private Function SelecionaArquivos() As Boolean

'On Error GoTo Error_Handler 'Ativa a rotina de tratamento de erro

Dim rsArquivo As ADODB.Recordset

Set rsArquivo = New ADODB.Recordset

If optTipo(0) Then

rsArquivo.Open "SELECT * FROM TblCida", db, adOpenStatic, adLockOptimistic

ImportaOutrosArquivos rsArquivo, "TBLCIDA"

ElseIf optTipo(1) Then

rsArquivo.Open "SELECT * FROM TblConc", db, adOpenStatic, adLockOptimistic

ImportaOutrosArquivos rsArquivo, "TBLCONC"

ElseIf optTipo(2) Then

rsArquivo.Open "SELECT * FROM TblVici", db, adOpenStatic, adLockOptimistic

ImportaOutrosArquivos rsArquivo, "TBLVICI"

ElseIf optTipo(3) Then

rsArquivo.Open "SELECT * FROM TblVien", db, adOpenStatic, adLockOptimistic

ImportaOutrosArquivos rsArquivo, "TBLVIEN"

ElseIf optTipo(4) Then

rsArquivo.Open "SELECT * FROM TblVico", db, adOpenStatic, adLockOptimistic

ImportaOutrosArquivos rsArquivo, "TBLVICO"

ElseIf optTipo(5) Then

rsArquivo.Open "SELECT * FROM TblViuf", db, adOpenStatic, adLockOptimistic

ImportaOutrosArquivos rsArquivo, "TBLVIUF"

ElseIf optTipo(6) Then

rsArquivo.Open "SELECT * FROM TblFtfa", db, adOpenStatic, adLockOptimistic

ImportaOutrosArquivos rsArquivo, "TBLFTFA"

ElseIf optTipo(7) Then

'rsArquivo.Open "SELECT * FROM TblSada", db, adOpenStatic, adLockOptimistic

rsArquivo.Open "SELECT * FROM TblSada", db, adOpenStatic, adLockOptimistic

ImportaArquivoSada rsArquivo

ElseIf optTipo(8) Then

rsArquivo.Open "SELECT * FROM TblFiat", db, adOpenStatic, adLockOptimistic

ImportaArquivoFiat rsArquivo

ElseIf optTipo(10) Then

rsArquivo.Open "SELECT * FROM TblVendaDiretaSada", db, adOpenStatic, adLockOptimistic

ImportaArquivoVendaDiretaSada rsArquivo

ElseIf optTipo(11) Then

rsArquivo.Open "SELECT * FROM TblVendaDiretaLocaliza", db, adOpenStatic, adLockOptimistic

ImportaArquivoVendaDiretaLocaliza rsArquivo

Else

rsArquivo.Open "SELECT * FROM TblKmFrota", db, adOpenStatic, adLockOptimistic

ImportaOutrosArquivos rsArquivo, "TBLKMFROTA"

End If

'rsArquivo.Close

Set rsArquivo = Nothing

SelecionaArquivos = True

Exit Function

Error_Handler: 'Rotina de tratamento de erro

'Call Err.Raise(Err.Number, ErrSource("FrmImportar", "SelecionaArquivos()"), Err.Description, Err.HelpFile, Err.HelpContext)

'Err.Clear

Resume

End Function

Private Function FinalizaImportacao() As Boolean

On Error GoTo Error_Handler 'Ativa a rotina de tratamento de erro

If Not bParar Then

MsgBox "Processo concluído com sucesso. " & vbLf & "Foram importados " & linhasTxt - 1 & " registros !", vbInformation, "Importação de arquivo mensal"

db.Execute "INSERT INTO [TblContImportacao] (Ano, Mes, NomeArquivo, DataImportacao, Registros) VALUES (" & (Year(DTArquivo)) & ", " & (Month(DTArquivo)) & ", '" & Dir(txtArquivo) & "', #" & Month(Date) & "/" & Day(Date) & "/" & Year(Date) & "#, " & linhasTxt - 1 & ");"

Else

If optTipo(0) Then

db.Execute "DELETE Mes AS Mes, Ano AS Ano From TblCida WHERE Mes= " & Month(DTArquivo) & " AND Ano= " & Year(DTArquivo) & ";"

ElseIf optTipo(1) Then

db.Execute "DELETE Mes AS Mes, Ano AS Ano From TblConc WHERE Mes= " & Month(DTArquivo) & " AND Ano= " & Year(DTArquivo) & ";"

ElseIf optTipo(2) Then

db.Execute "DELETE Mes AS Mes, Ano AS Ano From TblVici WHERE Mes= " & Month(DTArquivo) & " AND Ano= " & Year(DTArquivo) & ";"

ElseIf optTipo(3) Then

db.Execute "DELETE Mes AS Mes, Ano AS Ano From TblVien WHERE Mes= " & Month(DTArquivo) & " AND Ano= " & Year(DTArquivo) & ";"

ElseIf optTipo(4) Then

db.Execute "DELETE Mes AS Mes, Ano AS Ano From TblVico WHERE Mes= " & Month(DTArquivo) & " AND Ano= " & Year(DTArquivo) & ";"

ElseIf optTipo(5) Then

db.Execute "DELETE Mes AS Mes, Ano AS Ano From TblViuf WHERE Mes= " & Month(DTArquivo) & " AND Ano= " & Year(DTArquivo) & ";"

ElseIf optTipo(6) Then

db.Execute "DELETE Mes AS Mes, Ano AS Ano From TblFtfa WHERE Mes= " & Month(DTArquivo) & " AND Ano= " & Year(DTArquivo) & ";"

ElseIf optTipo(7) Then

db.Execute "DELETE * From TblSada WHERE (((Month([DtExped]))= " & Month(DTArquivo) & " ) AND ((Year([DtExped]))= " & Year(DTArquivo) & " ));"

ElseIf optTipo(9) Then

db.Execute "DELETE Mes AS Mes, Ano AS Ano From TblKmFrota WHERE Mes= " & Month(DTArquivo) & " AND Ano= " & Year(DTArquivo) & ";"

Else

'excluir registros importados no mês - Fiat

End If

MsgBox "Procedimento cancelado!", vbInformation + vbOKOnly

End If

FinalizaImportacao = True

Exit Function

Error_Handler: 'Rotina de tratamento de erro

Call Err.Raise(Err.Number, ErrSource("FrmImportar", "FinalizaImportacao()"), Err.Description, Err.HelpFile, Err.HelpContext)

Err.Clear

End Function

Private Sub ContProgressoBotoes(Bln As Boolean)

On Error GoTo Error_Handler 'Ativa a rotina de tratamento de erro

CmdImportar.Enabled = Not Bln

cmdFechar.Enabled = Not Bln

cmdCancelar.Enabled = Bln

lblMsg1.Visible = Bln

lblMsg1.ForeColor = &HFF&

ProgressBar1.Visible = Bln

Me.MousePointer = IIf(Bln = True, 13, 0)

Exit Sub

Error_Handler: 'Rotina de tratamento de erro

Call Err.Raise(Err.Number, ErrSource("FrmImportar", "ContProgressoBotoes()"), Err.Description, Err.HelpFile, Err.HelpContext)

Err.Clear

End Sub

Private Function ValidaDtArquivo() As Boolean

On Error GoTo Error_Handler 'Ativa a rotina de tratamento de erro

'Verifica se nome do arquivo selecionado coincide com mes e ano informados

If Not (Not optTipo(7) Or Not optTipo(8)) Then

If Mid(DTArquivo, 4, 2) & Mid(DTArquivo, 7, 2) <> Mid(txtArquivo, 5, 4) Then

MsgBox "A data selecionada é diferente da data do arquivo!", vbInformation + vbOKOnly

ValidaDtArquivo = False

Exit Function

End If

ElseIf optTipo(7) Then 'verifica data do arquivo sada

If Mid(DTArquivo, 4, 2) & Mid(DTArquivo, 9, 2) <> Mid(txtArquivo, 4, 4) Then

MsgBox "A data selecionada é diferente da data do arquivo!", vbInformation + vbOKOnly

ValidaDtArquivo = False

Exit Function

End If

ElseIf (optTipo(10) Or optTipo(11)) Then 'Arquivo Venda Direta Sada

If Mid(DTArquivo, 4, 2) <> Mid(txtArquivo, 7, 2) Then

MsgBox "A data selecionada é diferente da data do arquivo!", vbInformation + vbOKOnly

ValidaDtArquivo = False

Exit Function

End If

Else 'verifica data do arquivo fiat

End If

ValidaDtArquivo = True

Exit Function

Error_Handler: 'Rotina de tratamento de erro

Call Err.Raise(Err.Number, ErrSource("FrmImportar", "ValidaDtArquivo()"), Err.Description, Err.HelpFile, Err.HelpContext)

Err.Clear

End Function

Private Function ValidaNomeArquivo() As Boolean

On Error GoTo Error_Handler 'Ativa a rotina de tratamento de erro

'Verifica se arquivo informado é o mesmo do nome de arquivo selecionado

If optTipo(0) Then

If UCase(Left(txtArquivo, 4)) <> "CIDA" Then

MsgBox "O nome do arquivo é diferente do tipo de arquivo selecionado para importação." & vbLf & "Informe o tipo de arquivo correto para iniciar a importação !", vbInformation + vbOKOnly

ValidaNomeArquivo = False

Exit Function

End If

ElseIf optTipo(1) Then

If UCase(Left(txtArquivo, 4)) <> "CONC" Then

MsgBox "O nome do arquivo é diferente do tipo de arquivo selecionado para importação." & vbLf & "Informe o tipo de arquivo correto para iniciar a importação !", vbInformation + vbOKOnly

ValidaNomeArquivo = False

Exit Function

End If

ElseIf optTipo(2) Then

If UCase(Left(txtArquivo, 4)) <> "VICI" Then

MsgBox "O nome do arquivo é diferente do tipo de arquivo selecionado para importação." & vbLf & "Informe o tipo de arquivo correto para iniciar a importação !", vbInformation + vbOKOnly

ValidaNomeArquivo = False

Exit Function

End If

ElseIf optTipo(3) Then

If UCase(Left(txtArquivo, 4)) <> "VIEN" Then

MsgBox "O nome do arquivo é diferente do tipo de arquivo selecionado para importação." & vbLf & "Informe o tipo de arquivo correto para iniciar a importação !", vbInformation + vbOKOnly

ValidaNomeArquivo = False

Exit Function

End If

ElseIf optTipo(4) Then

If UCase(Left(txtArquivo, 4)) <> "VICO" Then

MsgBox "O nome do arquivo é diferente do tipo de arquivo selecionado para importação." & vbLf & "Informe o tipo de arquivo correto para iniciar a importação !", vbInformation + vbOKOnly

ValidaNomeArquivo = False

Exit Function

End If

ElseIf optTipo(5) Then

If UCase(Left(txtArquivo, 4)) <> "VIUF" Then

MsgBox "O nome do arquivo é diferente do tipo de arquivo selecionado para importação." & vbLf & "Informe o tipo de arquivo correto para iniciar a importação !", vbInformation + vbOKOnly

ValidaNomeArquivo = False

Exit Function

End If

ElseIf optTipo(6) Then

If UCase(Left(txtArquivo, 4)) <> "FTFA" Then

MsgBox "O nome do arquivo é diferente do tipo de arquivo selecionado para importação." & vbLf & "Informe o tipo de arquivo correto para iniciar a importação !", vbInformation + vbOKOnly

ValidaNomeArquivo = False

Exit Function

End If

ElseIf optTipo(7) Then

If UCase(Left(txtArquivo, 3)) <> "CHA" Then

MsgBox "O nome do arquivo é diferente do tipo de arquivo selecionado para importação." & vbLf & "Informe o tipo de arquivo correto para iniciar a importação !", vbInformation + vbOKOnly

ValidaNomeArquivo = False

Exit Function

End If

ElseIf optTipo(10) Then

If UCase(Left(txtArquivo, 6)) <> "FTVDSA" Then

MsgBox "O nome do arquivo é diferente do tipo de arquivo selecionado para importação." & vbLf & "Informe o tipo de arquivo correto para iniciar a importação !", vbInformation + vbOKOnly

ValidaNomeArquivo = False

Exit Function

End If

ElseIf optTipo(11) Then

If UCase(Left(txtArquivo, 6)) <> "FTVDLO" Then

MsgBox "O nome do arquivo é diferente do tipo de arquivo selecionado para importação." & vbLf & "Informe o tipo de arquivo correto para iniciar a importação !", vbInformation + vbOKOnly

ValidaNomeArquivo = False

Exit Function

End If

Else

'if 'Verificar arquivo da fiat

End If

ValidaNomeArquivo = True

Exit Function

Error_Handler: 'Rotina de tratamento de erro

Call Err.Raise(Err.Number, ErrSource("FrmImportar", "ValidaNomeArquivo()"), Err.Description, Err.HelpFile, Err.HelpContext)

Err.Clear

End Function

Private Sub ImportaArquivoFiat(ByVal rsArquivo As ADODB.Recordset)

On Error GoTo Error_Handler 'Ativa a rotina de tratamento de erro

Dim sLinha As String

Dim Linhas As Long

Linhas = 1

Open txtArquivo For Input As #1

Do While Not EOF(1)

DoEvents

If bParar = True Then Exit Sub 'força a saída da rotina quando pressionado "Cancelar"

Line Input #1, sLinha

ContMensagemStatus Linhas

GravaTblFiat sLinha, rsArquivo

Linhas = Linhas + 1

Loop

Close #1

Exit Sub

Error_Handler: 'Rotina de tratamento de erro

Call Err.Raise(Err.Number, ErrSource("FrmImportar", "ImportaArquivoFiat()"), Err.Description, Err.HelpFile, Err.HelpContext)

Err.Clear

End Sub

Private Sub ImportaArquivoVendaDiretaSada(ByVal rsArquivo As ADODB.Recordset)

On Error GoTo Error_Handler 'Ativa a rotina

Link para o comentário
Compartilhar em outros sites

Participe da discussão

Você pode postar agora e se registrar depois. Se você já tem uma conta, acesse agora para postar com sua conta.

Visitante
Responder esta pergunta...

×   Você colou conteúdo com formatação.   Remover formatação

  Apenas 75 emoticons são permitidos.

×   Seu link foi incorporado automaticamente.   Exibir como um link em vez disso

×   Seu conteúdo anterior foi restaurado.   Limpar Editor

×   Você não pode colar imagens diretamente. Carregar ou inserir imagens do URL.

×
 Share
Ir para lista de Perguntas


  • Estatísticas dos Fóruns

    • Tópicos
      152,3k
    • Posts
      652,4k
×
×
  • Criar Novo...