Public Sub GerarAgregLinhas()
On Error GoTo final
Dim sValor1 As String 'Guarda valores do campo1
Dim sExtratoCnpj As String 'extrai o cnpj da string
Dim iRegistros As Long 'Total de registros da tabela
Dim sImpAgregado As String
Dim sAgregadoLinhas As String
'****Variáveis------------------------
Dim sCnpj As String
Dim sContribuinte As String
Dim sCompetencia As String
Dim sFpas As String
Dim sCodTerceiros As String
Dim sAliquotaRat As String
Dim sSimplesCadastro As String
Dim sSimplesGfip As String
Dim sGrauFilantropia As String
Dim sCodPagamentoGps As String
Dim sQuantGfipDec As String
Dim sQuantGfipPag As String
Dim sTipoCaptacao As String
Dim sVrDevidoPrevSocial As String
Dim sDed13SalMaternidade As String
Dim sProdRuralPF As String
Dim sCompensacao As String
Dim sProdRuralPJ As String
Dim sContrSegurados_CapaGfip As String
Dim sRetencaoLei9711 As String
Dim sFatsEmitsTomador As String
Dim sDedSalFamilia As String
Dim sLicencaMaternidade As String
Dim sCat14_16QuantVinc As String
Dim sDedSalMaternidade As String
Dim sCooperativaSemAgNoc As String
Dim sCat14_16SalBase As String
Dim sRecEventosDesportivos As String
Dim sQuantVinculosEmpr As String
Dim sRemuneracaoEmpr As String
Dim sContribSegEmpregados As String
Dim sDecTercSalarioEmpr As String
Dim sEmpregadosPend As String
Dim sQuantVincCateg05_11_13 As String
Dim sRemunCateg05_11_13 As String
Dim sContribCateg05_11_13 As String
Dim sCateg05_11_13Pend As String
Dim sQuantVincCateg15 As String
Dim sRemunCateg15 As String
Dim sContribCateg15 As String
Dim sCateg15Pend As String
Dim sQuantVincCateg16 As String
Dim sRemunCateg16 As String
Dim sContribCateg16 As String
Dim sCateg16Pend As String
Dim sQuantVincCateg17 As String
Dim sRemunCateg17 As String
Dim sContribCateg17 As String
Dim sCateg17Pend As String
Dim sQuantVincCateg18 As String
Dim sRemunCateg18 As String
Dim sContribCateg18 As String
Dim sCateg18Pend As String
Dim sQuantVincCateg22 As String
Dim sRemunCateg22 As String
Dim sContribCateg22 As String
Dim sCateg22Pend As String
Dim sQuantVincCateg23 As String
Dim sRemunCateg23 As String
Dim sContribCateg23 As String
Dim sCateg23Pend As String
Dim sQuantVincCateg24 As String
Dim sRemunCateg24 As String
Dim sContribCateg24 As String
Dim sCateg24Pend As String
Dim sQuantVincCateg25 As String
Dim sRemunCateg25 As String
Dim sContribCateg25 As String
Dim sCateg25Pend As String
Dim sQuantAgNocEmpr15 As String
Dim sRemAgNocEmpr15 As String
Dim sDecTercAgNocEmpr15 As String
Dim sQuantAgNocCoopProd15 As String
Dim sRemAgNocCoopProd15 As String
Dim sQuantAgNocEmpr20 As String
Dim sRemAgNocEmpr20 As String
Dim sDecTercAgNocEmpr20 As String
Dim sQuantAgNocCoopProd20 As String
Dim sRemAgNocCoopProd20 As String
Dim sQuantAgNocEmpr25 As String
Dim sRemAgNocEmpr25 As String
Dim sDecTercAgNocEmpr25 As String
Dim sQuantAgNocCoopProd25 As String
Dim sRemAgNocCoopProd25 As String
Dim sTotNFCoopTrab15 As String
Dim sTotNFCoopTrab20 As String
Dim sTotNFCoopTrab25 As String
'***-------------------------------------------------------------
frmCnisa.MousePointer = 11
sImpAgregado = "SELECT * FROM tblImpAgregado"
sAgregadoLinhas = "SELECT * FROM tblAgregadoLinhas"
FecharRst
FecharRst2
rst.Open sImpAgregado, cnBd, adOpenKeyset, adLockOptimistic
rst2.Open sAgregadoLinhas, cnBd, adOpenKeyset, adLockOptimistic
iRegistros = rst.RecordCount + 1
Dim cont As Long
rst.MoveMin
Do While Not rst.EOF 'loop geral para varrer a tabela
cont = 1
Do While cont < 50 'Loop intermediário - serão incluídos os 49 primeiros registros
sValor1 = rst!Campo1
If cont = 1 Then
sExtratoCnpj = Mid(sValor1, 35, 18)
sCnpj = sExtratoCnpj
ElseIf cont = 2 Then
sContribuinte = Mid(sValor1, 28, 53)
ElseIf cont = 3 Then
sCompetencia = Mid(sValor1, 28, 7)
ElseIf cont = 4 Then
sFpas = Mid(sValor1, 28, 3)
ElseIf cont = 8 Then
sCodTerceiros = Mid(sValor1, 5, 11)
sAliquotaRat = Mid(sValor1, 21, 10)
sSimplesCadastro = Mid(sValor1, 40, 7)
sSimplesGfip = Mid(sValor1, 50, 4)
sGrauFilantropia = Mid(sValor1, 62, 10)
sCodPagamentoGps = Mid(sValor1, 84, 6)
ElseIf cont = 10 Then
sQuantGfipDec = Mid(sValor1, 10, 7)
sQuantGfipPag = Mid(sValor1, 30, 10)
sTipoCaptacao = Mid(sValor1, 47, 16)
ElseIf cont = 13 Then
sVrDevidoPrevSocial = Mid(sValor1, 13, 24)
sDed13SalMaternidade = Mid(sValor1, 35, 24)
sProdRuralPF = Mid(sValor1, 65, 24)
ElseIf cont = 15 Then
sCompensacao = Mid(sValor1, 45, 14)
sProdRuralPJ = Mid(sValor1, 70, 19)
ElseIf cont = 17 Then
sContrSegurados_CapaGfip = Mid(sValor1, 10, 20)
sRetencaoLei9711 = Mid(sValor1, 40, 20)
sFatsEmitsTomador = Mid(sValor1, 69, 20)
ElseIf cont = 19 Then
sDedSalFamilia = Mid(sValor1, 10, 19)
sLicencaMaternidade = Mid(sValor1, 40, 19)
sCat14_16QuantVinc = Mid(sValor1, 79, 10)
ElseIf cont = 21 Then
sDedSalMaternidade = Mid(sValor1, 10, 19)
sCooperativaSemAgNoc = Mid(sValor1, 40, 19)
sCat14_16SalBase = Mid(sValor1, 79, 10)
ElseIf cont = 23 Then
sRecEventosDesportivos = Mid(sValor1, 35, 24)
ElseIf cont = 26 Then
sQuantVinculosEmpr = Mid(sValor1, 4, 7)
sRemuneracaoEmpr = Mid(sValor1, 17, 19)
sContribSegEmpregados = Mid(sValor1, 40, 22)
sDecTercSalarioEmpr = Mid(sValor1, 65, 21)
sEmpregadosPend = Mid(sValor1, 87, 2)
ElseIf cont = 29 Then
sQuantVincCateg05_11_13 = Mid(sValor1, 15, 9)
sRemunCateg05_11_13 = Mid(sValor1, 35, 18)
sContribCateg05_11_13 = Mid(sValor1, 65, 17)
sCateg05_11_13Pend = Mid(sValor1, 87, 2)
ElseIf cont = 30 Then
sQuantVincCateg15 = Mid(sValor1, 15, 9)
sRemunCateg15 = Mid(sValor1, 35, 18)
sContribCateg15 = Mid(sValor1, 65, 17)
sCateg15Pend = Mid(sValor1, 87, 2)
ElseIf cont = 31 Then
sQuantVincCateg16 = Mid(sValor1, 15, 9)
sRemunCateg16 = Mid(sValor1, 35, 18)
sContribCateg16 = Mid(sValor1, 65, 17)
sCateg16Pend = Mid(sValor1, 87, 2)
ElseIf cont = 32 Then
sQuantVincCateg17 = Mid(sValor1, 15, 9)
sRemunCateg17 = Mid(sValor1, 35, 18)
sContribCateg17 = Mid(sValor1, 65, 17)
sCateg17Pend = Mid(sValor1, 87, 2)
ElseIf cont = 33 Then
sQuantVincCateg18 = Mid(sValor1, 15, 9)
sRemunCateg18 = Mid(sValor1, 35, 18)
sContribCateg18 = Mid(sValor1, 65, 17)
sCateg18Pend = Mid(sValor1, 87, 2)
ElseIf cont = 34 Then
sQuantVincCateg22 = Mid(sValor1, 15, 9)
sRemunCateg22 = Mid(sValor1, 35, 18)
sContribCateg22 = Mid(sValor1, 65, 17)
sCateg22Pend = Mid(sValor1, 87, 2)
ElseIf cont = 35 Then
sQuantVincCateg23 = Mid(sValor1, 15, 9)
sRemunCateg23 = Mid(sValor1, 35, 18)
sContribCateg23 = Mid(sValor1, 65, 17)
sCateg23Pend = Mid(sValor1, 87, 2)
ElseIf cont = 36 Then
sQuantVincCateg24 = Mid(sValor1, 15, 9)
sRemunCateg24 = Mid(sValor1, 35, 18)
sContribCateg24 = Mid(sValor1, 65, 17)
sCateg24Pend = Mid(sValor1, 87, 2)
ElseIf cont = 37 Then
sQuantVincCateg25 = Mid(sValor1, 15, 9)
sRemunCateg25 = Mid(sValor1, 35, 18)
sContribCateg25 = Mid(sValor1, 65, 17)
sCateg25Pend = Mid(sValor1, 87, 2)
ElseIf cont = 41 Then
sQuantAgNocEmpr15 = Mid(sValor1, 10, 6)
sRemAgNocEmpr15 = Mid(sValor1, 20, 18)
sDecTercAgNocEmpr15 = Mid(sValor1, 45, 17)
sQuantAgNocCoopProd15 = Mid(sValor1, 63, 5)
sRemAgNocCoopProd15 = Mid(sValor1, 74, 17)
ElseIf cont = 42 Then
sQuantAgNocEmpr20 = Mid(sValor1, 10, 6)
sRemAgNocEmpr20 = Mid(sValor1, 20, 18)
sDecTercAgNocEmpr20 = Mid(sValor1, 45, 17)
sQuantAgNocCoopProd20 = Mid(sValor1, 63, 5)
sRemAgNocCoopProd20 = Mid(sValor1, 74, 17)
ElseIf cont = 43 Then
sQuantAgNocEmpr25 = Mid(sValor1, 10, 6)
sRemAgNocEmpr25 = Mid(sValor1, 20, 18)
sDecTercAgNocEmpr25 = Mid(sValor1, 45, 17)
sQuantAgNocCoopProd25 = Mid(sValor1, 63, 5)
sRemAgNocCoopProd25 = Mid(sValor1, 74, 17)
ElseIf cont = 45 Then
sTotNFCoopTrab15 = Mid(sValor1, 32, 12)
sTotNFCoopTrab20 = Mid(sValor1, 45, 24)
sTotNFCoopTrab25 = Mid(sValor1, 70, 21)
End If
'MsgBox sSelecao, vbInformation, cont
rst.MoveNext
cont = cont + 1
'-------------------------------------------
frmCnisa.ProgressBar1.Value = frmCnisa.ProgressBar1.Value + 1
DoEvents
'-------------------------------------------
If Len(sCnpj) <> 0 Then
sCnpj = Replace(sCnpj, ".", "")
sCnpj = Replace(sCnpj, "/", "")
sCnpj = Replace(sCnpj, "-", "")
End If
Loop 'final do loop específico
rst2.AddNew
rst2!Cnpj = sCnpj
rst2!Contribuinte = sContribuinte
rst2!Competencia = sCompetencia
rst2!Fpas = sFpas
rst2!CodTerceiros = sCodTerceiros
rst2!AliquotaRat = sAliquotaRat
rst2!SimplesCadastro = sSimplesCadastro
rst2!SimplesGfip = sSimplesGfip
rst2!GrauFilantropia = sGrauFilantropia
rst2!CodPagamentoGps = sCodPagamentoGps
rst2!QuantGfipDec = sQuantGfipDec
rst2!QuantGfipPag = sQuantGfipPag
rst2!TipoCaptacao = sTipoCaptacao
rst2!VrDevidoPrevSocial = sVrDevidoPrevSocial
rst2!Ded13SalMaternidade = sDed13SalMaternidade
rst2!ProdRuralPF = sProdRuralPF
rst2!Compensacao = sCompensacao
rst2!ProdRuralPJ = sProdRuralPJ
rst2!ContrSegurados_CapaGfip = sContrSegurados_CapaGfip
rst2!RetencaoLei9711 = sRetencaoLei9711
rst2!FatsEmitsTomador = sFatsEmitsTomador
rst2!DedSalFamilia = sDedSalFamilia
rst2!LicencaMaternidade = sLicencaMaternidade
rst2!Cat14_16QuantVinc = sCat14_16QuantVinc
rst2!DedSalMaternidade = sDedSalMaternidade
rst2!CooperativaSemAgNoc = sCooperativaSemAgNoc
rst2!Cat14_16SalBase = sCat14_16SalBase
rst2!RecEventosDesportivos = sRecEventosDesportivos
rst2!QuantVinculosEmpr = sQuantVinculosEmpr
rst2!RemuneracaoEmpr = sRemuneracaoEmpr
rst2!ContribSegEmpregados = sContribSegEmpregados
rst2!DecTercSalarioEmpr = sDecTercSalarioEmpr
rst2!EmpregadosPend = sEmpregadosPend
rst2!QuantVincCateg05_11_13 = sQuantVincCateg05_11_13
rst2!RemunCateg05_11_13 = sRemunCateg05_11_13
rst2!ContribCateg05_11_13 = sContribCateg05_11_13
rst2!Categ05_11_13Pend = sCateg05_11_13Pend
rst2!QuantVincCateg15 = sQuantVincCateg15
rst2!RemunCateg15 = sRemunCateg15
rst2!ContribCateg15 = sContribCateg15
rst2!Categ15Pend = sCateg15Pend
rst2!QuantVincCateg16 = sQuantVincCateg16
rst2!RemunCateg16 = sRemunCateg16
rst2!ContribCateg16 = sContribCateg16
rst2!Categ16Pend = sCateg16Pend
rst2!QuantVincCateg17 = sQuantVincCateg17
rst2!RemunCateg17 = sRemunCateg17
rst2!ContribCateg17 = sContribCateg17
rst2!Categ17Pend = sCateg17Pend
rst2!QuantVincCateg18 = sQuantVincCateg18
rst2!RemunCateg18 = sRemunCateg18
rst2!ContribCateg18 = sContribCateg18
rst2!Categ18Pend = sCateg18Pend
rst2!QuantVincCateg22 = sQuantVincCateg22
rst2!RemunCateg22 = sRemunCateg22
rst2!ContribCateg22 = sContribCateg22
rst2!Categ22Pend = sCateg22Pend
rst2!QuantVincCateg23 = sQuantVincCateg23
rst2!RemunCateg23 = sRemunCateg23
rst2!ContribCateg23 = sContribCateg23
rst2!Categ23Pend = sCateg23Pend
rst2!QuantVincCateg24 = sQuantVincCateg24
rst2!RemunCateg24 = sRemunCateg24
rst2!ContribCateg24 = sContribCateg24
rst2!Categ24Pend = sCateg24Pend
rst2!QuantVincCateg25 = sQuantVincCateg25
rst2!RemunCateg25 = sRemunCateg25
rst2!ContribCateg25 = sContribCateg25
rst2!Categ25Pend = sCateg25Pend
rst2!QuantAgNocEmpr15 = sQuantAgNocEmpr15
rst2!RemAgNocEmpr15 = sRemAgNocEmpr15
rst2!DecTercAgNocEmpr15 = sDecTercAgNocEmpr15
rst2!QuantAgNocCoopProd15 = sQuantAgNocCoopProd15
rst2!RemAgNocCoopProd15 = sRemAgNocCoopProd15
rst2!QuantAgNocEmpr20 = sQuantAgNocEmpr20
rst2!RemAgNocEmpr20 = sRemAgNocEmpr20
rst2!DecTercAgNocEmpr20 = sDecTercAgNocEmpr20
rst2!QuantAgNocCoopProd20 = sQuantAgNocCoopProd20
rst2!RemAgNocCoopProd20 = sRemAgNocCoopProd20
rst2!QuantAgNocEmpr25 = sQuantAgNocEmpr25
rst2!RemAgNocEmpr25 = sRemAgNocEmpr25
rst2!DecTercAgNocEmpr25 = sDecTercAgNocEmpr25
rst2!QuantAgNocCoopProd25 = sQuantAgNocCoopProd25
rst2!RemAgNocCoopProd25 = sRemAgNocCoopProd25
rst2!TotNFCoopTrab15 = sTotNFCoopTrab15
rst2!TotNFCoopTrab20 = sTotNFCoopTrab20
rst2!TotNFCoopTrab25 = sTotNFCoopTrab25
rst2.Update
Loop
FecharRst
FecharRst2
frmCnisa.MousePointer = 0
'MsgBox "Agregado linhas importado com sucesso!!", vbInformation, "Exportação concluída!!"
Exit Sub
final:
FecharRst
FecharRst2
MsgBox Err.Description, vbInformation, Err.Number & "Gerando o relatório de agregado em linhas!!"
End Sub
O arquivo texto a ser importado possui 49 linhas que são lidas pelo vb por vez. Após a leitura da 49, os registros são salvos na tabela corretamente.
O código acima está funcionando perfeitamente; no entanto, quanto importo arquivos grandes, ele faz confusão com relação à identificação (referência) da linha. Exemplo: o vb começa importanto corretamente, depois, quando chega no meio do arquivo texto, o loop que está na quadragésima linha, interpreta que está na quadragésima primeira linha, fazendo com que a importação a partir daí fique incorreta..
Alguém sabe o que está faltando no código acima?
Desde já agradeco..
