Olá,
Alguém sabe onde encontrar? ou já usou algum programa que gere um arquivo texto para ser importado por um programa da receita federal, é que eu estou com problema para que o Programa DOI 6.0 da receita federal importe um arquivo texto gerado pelo meu programa em VB6. A rotina que utilizei é como mostra abaixo e quando tento importar pela receita federal dá erro de registro incompatível. Alguém poderia me ajudar, por favor, estou precisando com muita urgência. Alguém me ajude?
rotina utilizada para gerar o arquivo:
Private Sub CmdGeraDOI_Click()
'Leia comentários da rotina "cmdImprimir_Click" em "dlgImpBancoCartorio".
On Error GoTo errImpressao
gMensagem = "geração da impressão"
'define variáveis
Dim fs As Scripting.FileSystemObject
Dim texto As Scripting.TextStream
Dim F As Long, Linha As String
Dim M_Livro, M_Folha, M_Matric, M_Forma_Alienacao, M_TIPO_TRANS, M_Logradouro, M_Numero_Imv, M_Complemento_imv, M_Bairro_imv, M_CEP, M_Municipio, M_CPF_PROCURADOR, M_Registro, M_PARTICIPACAO, M_VALOR_ITBI, M_VALOR_ALIENACAO, M_AREA, M_CNPJ_CGC As String
' Dim M_VALOR_ITBI, M_VALOR_ALIENACAO, M_AREA As Double
Dim contador As Long
Dim B, CONT, M_VALOR_ITBI_NAO, M_VALOR_CONSTA, M_AREA_NAO, M_TIPO_IMOVEL As Integer
'>>>> abre os arquivos para gravação dos registros
' F = FreeFile
' Open Txt_remessa.Text For Input As F 'abre o arquivo texto
' cria os objetos filesystemobject
' M_CARTORIO1 = "C:EXPORTADOI.TXT"
Set fs = New Scripting.FileSystemObject
Set texto = fs.OpenTextFile(txt_confirmacao.Text, ForWriting, True)
'>>>>>>> INICIA GRAVAÇÃO REGISTRO TIPO 1 - Dados da Operação
gSQL = "SELECT * FROM tbClienteEscritura where (DATA Between #" & Format(DTP_DT_INICIAL, "dd/mm/yyyy") & "# And #" & Format(DTP_DT_FINAL, "dd/mm/yyyy") & "#)"
' gSQL = "SELECT * FROM tbClienteEscritura where DATA >= " & Format(DTP_DT_INICIAL, "DD/MM/YYYY") & " and DATA <= " & Format(DTP_DT_FINAL, "DD/MM/YYYY") & ""
Set gRS = gDB.OpenRecordset(gSQL)
Do While Not gRS.EOF
'atualiza contador
CONT = CONT + 1
B = 7 - Len(gRS!Livro)
M_Livro = Space(B) + CStr(gRS!Livro)
B = 5 - Len(gRS!Folha)
M_Folha = Space(B) + CStr(gRS!Folha)
B = 15 - Len(gRS!Matric)
M_Matric = Space(B) + gRS!Matric
B = 15 - Len(gRS!Registro)
M_Registro = Space(B) + gRS!Registro
If gRS!Forma_Alienação = 1 Then
M_Forma_Alienacao = 5
ElseIf gRS!Forma_Alienação = 2 Then
M_Forma_Alienacao = 7
End If
M_TIPO_TRANS = gRS!TIPO_TRANSACAO
Select Case M_TIPO_TRANS
Case 0 ' 15 - Adjudicação
M_TIPO_TRANS = 15
Case 1 ' 41 - Arrematação em Hasta Pública
M_TIPO_TRANS = 41
Case 2 ' 37 - Cessão de Direitos
M_TIPO_TRANS = 37
Case 3 '11 - Compra e Venda
M_TIPO_TRANS = 11
Case 4 '19 - Dação em Pagamento
M_TIPO_TRANS = 19
Case 5 '25 - Desapropriação
M_TIPO_TRANS = 25
Case 6 '43 - Dissolução de Sociedade
M_TIPO_TRANS = 43
Case 7 '21 - Distrato de Negócio
M_TIPO_TRANS = 21
Case 8 '53 - Doação
M_TIPO_TRANS = 53
Case 9 '55 - Doação em adiantamento da legítima
M_TIPO_TRANS = 55
Case 10 '27 - Herança, Legado ou Meação (adjudicação)
M_TIPO_TRANS = 27
Case 11 '45 - Incorporação e loteamento
M_TIPO_TRANS = 45
Case 12 '47 - Integralização/Subscrição de capital
M_TIPO_TRANS = 47
Case 13 '49 - Partilha amigável ou litigiosa
M_TIPO_TRANS = 49
Case 14 '13 - Permuta
M_TIPO_TRANS = 13
Case 15 '31 - Procuração em Causa Própria
M_TIPO_TRANS = 31
Case 16 '35 - Promessa de Cessão de Direitos
M_TIPO_TRANS = 35
Case 17 '33 - Promessa de Compra e Venda
M_TIPO_TRANS = 33
Case 18 '51 - Retorno de Capital próprio
M_TIPO_TRANS = 51
Case 19 '39 - Outros
M_TIPO_TRANS = 39
End Select
M_VALOR_ITBI = Format(gRS!Valor_ITBI, "###########0.00")
B = 15 - Len(M_VALOR_ITBI)
M_VALOR_ITBI = Space(B) + CStr(M_VALOR_ITBI)
If gRS!Valor_ITBI > 0 Then
M_VALOR_ITBI_NAO = 0
Else
M_VALOR_ITBI_NAO = 1
End If
M_VALOR_ALIENACAO = Format(gRS!Valor_BASE, "###########0.00")
B = 15 - Len(M_VALOR_ALIENACAO)
M_VALOR_ALIENACAO = Space(B) + CStr(M_VALOR_ALIENACAO)
If gRS!Valor_BASE > 0 Then
M_VALOR_CONSTA = 0
Else
M_VALOR_CONSTA = 1
End If
' M_VALOR = Replace(M_VALOR, ",", "")
' M_VALOR = Replace(M_VALOR, ".", "")
' M_VALOR = Format(M_VALOR, "00000000000000")
M_TIPO_IMOVEL = gRS!TIPO_IMOVEL
Select Case M_TIPO_IMOVEL
Case 0 ' 67 - Casa
M_TIPO_IMOVEL = 67
Case 1 '65 - Apto
M_TIPO_IMOVEL = 65
Case 2 '15 - Loja
M_TIPO_IMOVEL = 15
Case 3 '17 - Sala/Conjunto
M_TIPO_IMOVEL = 17
Case 4 '71 - Terreno/fração
M_TIPO_IMOVEL = 71
Case 5 '31 - Galpão
M_TIPO_IMOVEL = 31
Case 6 '33 - Prédio Comercial
M_TIPO_IMOVEL = 33
Case 7 '35 - Prédio Residencial
M_TIPO_IMOVEL = 35
Case 8 '69 - Fazenda/Sítio/Chácara
M_TIPO_IMOVEL = 69
Case 9 '89 - Outros
M_TIPO_IMOVEL = 89
End Select
If Not IsNull(gRS!area_imovel) And gRS!area_imovel <> 0 Then
M_AREA = Format(gRS!area_imovel, "#############0.00")
B = 17 - Len(M_AREA)
M_AREA = Space(B) + M_AREA
M_AREA_NAO = 0
Else
M_AREA = Format(gRS!area, "00000000000000000")
M_AREA_NAO = 1
End If
B = 40 - Len(gRS!Logradouro_imovel)
M_Logradouro = Space(B) + gRS!Logradouro_imovel
B = 6 - Len(gRS!Numero_imovel)
M_Numero_Imv = Space(B) + gRS!Numero_imovel
If Not IsNull(gRS!Complemento_imovel) Then
B = 21 - Len(gRS!Complemento_imovel)
M_Complemento_imv = Space(B) + gRS!Complemento_imovel
Else
B = 21
M_Complemento_imv = Space(B)
End If
B = 20 - Len(gRS!Bairro_imovel)
M_Bairro_imv = Space(B) + gRS!Bairro_imovel
B = 30 - Len(gRS!Municipio_imovel)
M_Municipio = Space(B) + gRS!Municipio_imovel
M_CEP = Format(gRS!CEP_imovel, "00000000")
'grava registro TIPO1 - Dados da Operação
' texto.Write 1 & Space(10) & Format(gRS!DATA, "DD/MM/YYYY") & M_Livro & M_Folha & M_Matric & M_Registro & "0" & "1" & M_TIPO_TRANS & Space(30) & 0 & gRS!Data_alienacao & M_Forma_Alienacao & M_VALOR_CONSTA & M_VALOR_ALIENACAO & M_VALOR_ITBI & M_TIPO_IMOVEL & Space(30) & gRS!Andamento_Imovel & gRS!Localizacao_Imovel & M_AREA_NAO & M_AREA & M_Logradouro & M_Numero_Imv & M_Complemento_imv & M_Bairro_imv & M_CEP & M_Municipio & gRS!UF_IMOVEL & Space(15) & M_VALOR_ITBI_NAO & Space(30) & Chr(Hex(d)) & Chr(Hex(a)) & vbCrLf
texto.Write 1 & Space(10) & Format(gRS!DATA, "DD/MM/YYYY") & M_Livro & M_Folha & M_Matric & M_Registro & "0" & "1" & M_TIPO_TRANS & Space(30) & 0 & gRS!Data_alienacao & M_Forma_Alienacao & M_VALOR_CONSTA & M_VALOR_ALIENACAO & M_VALOR_ITBI & M_TIPO_IMOVEL & Space(30) & gRS!Andamento_Imovel & gRS!Localizacao_Imovel & M_AREA_NAO & M_AREA & M_Logradouro & M_Numero_Imv & M_Complemento_imv & M_Bairro_imv & M_CEP & M_Municipio & gRS!UF_IMOVEL & Space(15) & M_VALOR_ITBI_NAO & Space(30) & "10" & vbCrLf
'>>>>>>>>> INICIA GRAVAÇÃO registro TIPO2 - Dados dos Alienantes
gSQL = "SELECT * FROM TbCliEsc_Alienantes WHERE IdClienteEscritura = " & gRS!IdClienteEscritura & ""
Set gRSTemp = gDB.OpenRecordset(gSQL)
Do While Not gRSTemp.EOF
CONT = CONT + 1
M_PARTICIPACAO = Format(gRSTemp!Perc_Participacao, "000.00")
' B = 6 - Len(M_PARTICIPACAO)
' M_PARTICIPACAO = Space(B) + M_PARTICIPACAO
M_CNPJ_CGC = gRSTemp!CGC_CPF
M_CNPJ_CGC = Replace(M_CNPJ_CGC, ",", "")
M_CNPJ_CGC = Replace(M_CNPJ_CGC, ".", "")
M_CNPJ_CGC = Replace(M_CNPJ_CGC, "/", "")
M_CNPJ_CGC = Replace(M_CNPJ_CGC, "-", "")
M_CNPJ_CGC = Format(M_CNPJ_CGC, "00000000000000")
If Not IsNull(gRSTemp!CPF_Procurador) Then
M_CPF_PROCURADOR = Format(gRSTemp!CPF_Procurador, "00000000000")
Else
M_CPF_PROCURADOR = "00000000000"
End If
' grava registro TIPO2 - Dados dos Alienantes
texto.Write 2 & Space(10) & M_CNPJ_CGC & Space(115) & M_PARTICIPACAO & M_CPF_PROCURADOR & Space(208) & "10" & vbCrLf
gRSTemp.MoveNext
Loop
'>>>>>>>>> INICIA GRAVAÇÃO registro TIPOTIPO 3 - Dados dos Adquirentes
gSQL = "SELECT * FROM TbCliEsc_Adquirentes WHERE IdClienteEscritura = " & gRS!IdClienteEscritura & ""
Set gRSTemp = gDB.OpenRecordset(gSQL)
Do While Not gRSTemp.EOF
CONT = CONT + 1
M_PARTICIPACAO = Format(gRSTemp!Perc_Participacao, "000.00")
M_CNPJ_CGC = gRSTemp!CGC_CPF
M_CNPJ_CGC = Replace(M_CNPJ_CGC, ",", "")
M_CNPJ_CGC = Replace(M_CNPJ_CGC, ".", "")
M_CNPJ_CGC = Replace(M_CNPJ_CGC, "/", "")
M_CNPJ_CGC = Replace(M_CNPJ_CGC, "-", "")
M_CNPJ_CGC = Format(M_CNPJ_CGC, "00000000000000")
If Not IsNull(gRSTemp!CPF_Procurador) Then
M_CPF_PROCURADOR = Format(gRSTemp!CPF_Procurador, "00000000000")
Else
M_CPF_PROCURADOR = "00000000000"
End If
'grava registro TIPO3 - Dados dos Adquirentes
texto.Write 3 & Space(10) & M_CNPJ_CGC & Space(115) & M_PARTICIPACAO & M_CPF_PROCURADOR & Space(208) & "10" & vbCrLf
gRSTemp.MoveNext
Loop
gRS.MoveNext
Loop
If Not IsEmpty(CONT) Then
CONT = Format(CONT + 1, "000000")
texto.Write 9 & Space(16) & CONT & Space(342) & "10" & vbCrLf
End If
'******fim da impressao
saida:
' Unload Me 'Descarrega da memória o formulário atualmente ativo ("dlgImpCliEscritura")
Exit Sub
errImpressao:
Erro gMensagem
Exit Sub
End Sub
