[Resolvido]ERRO GERAR ARQUIVO TXT DUAS TABELAS

Caros,

Tentei localizar no fórum uma solução para o meu problema mas não localizei por isso apelo aos amigos a quem possa me ajudar.
Tenho duas tabelas no aplicativo onde a partir delas preciso criar um txt:

TBL_C100_S = Dados de Cabeçalho de NF

TBL_C190_S = Dados de detalhe de NF

No layout do SPED preciso colocar no arquivo TXT em sequencia sendo para cada Registro C100 tenho que ter um Registro C190 sendo na sequencia

Reg NF
C100 1
C190 1
C100 2
C190 2

Não manjo quase nda de VBA sou um curioso e buscando ajuda no forum consegui chegar no código:


Function Gerar()


Dim Cnn As New ADODB.Connection
Dim Rs1 As New ADODB.Recordset
Dim Rs2 As New ADODB.Recordset
Dim ID As Long
Dim caminho As String

'Verifica se existe pasta C:\
Set fso = CreateObject("Scripting.FileSystemObject")
If fso.FolderExists("C:\Arquivos_Teste") Then ' verifica se já existe a pasta
Else
MkDir "C:\Arquivos_Teste" ' se não existir cria
End If


caminho = "C:\Arquivos_Teste\" & "TESTE.txt"

Set Cnn = CurrentProject.Connection
Set Rs1.ActiveConnection = Cnn
Set Rs2.ActiveConnection = Cnn

Rs1.CursorType = adDynamic
Rs1.LockType = adLockOptimistic

Rs2.CursorType = adDynamic
Rs2.LockType = adLockOptimistic

Rs1.Open "Select * From TBL_C100_S", Cnn


Open caminho For Output As #1
If Not Rs1.EOF Then

Do Until Rs1.EOF
ID = Rs1!ID_NF
Rs2.Open "SELECT * FROM TBL_C190_S WHERE ID_NF= " & ID & "", Cnn

Print #1, Chr(124) & Rs1!REG & Chr(124) & Rs1!IND_OPER & Chr(124) & Rs1!IND_EMIT & Chr(124) & Rs1!COD_PART & Chr(124) & vbCrLf & _
Chr(124) & Rs2!REG & Chr(124) & Rs2!CST_ICMS & Chr(124) & Rs2!CFOP & Chr(124) & Rs2!ALIQ_ICMS & Chr(124)

Rs1.MoveNext

Loop
End If

Close #1

Rs2.Close
Rs1.Close
Cnn.Close
Set Rs1 = Nothing
Set Rs2 = Nothing
Set Cnn = Nothing

End Function

O problema é que somente esta preechendo o arquivo txt com a informação da primeira NF ocorrendo erro na segunda de: "Erro tempo de execução 3705"

Poderia me ajudar a corrigir..

Obrigado

Luis Carlos

Boa noite, luiis
Utilize
Sub Gerar()
Dim Rs1 As DAO.Recordset, Rs2 As DAO.Recordset
Dim ID As Long
Dim caminho As String
Dim fso

'Verifica se existe pasta C:\
Set fso = CreateObject("Scripting.FileSystemObject")
If fso.FolderExists("C:\Arquivos_Teste") Then ' verifica se já existe a pasta
Else
MkDir "C:\Arquivos_Teste" ' se não existir cria
End If


caminho = "C:\Arquivos_Teste\" & "TESTE.txt"

Set Rs1=currentdb.openrecordset("SELECT * FROM TBL_C100_S;")
Set Rs2=currentdb.openrecordset("SELECT * FROM TBL_C190_S;")

Open caminho For Output As #1
If Not Rs1.EOF Then
Do Until Rs1.EOF
ID = Rs1!ID_NF
Print #1, Chr(124) & Rs1!REG & Chr(124) & Rs1!IND_OPER & Chr(124) & Rs1!IND_EMIT & Chr(124) & Rs1!COD_PART & Chr(124) & vbCrLf & _
Chr(124) & Rs2!REG & Chr(124) & Rs2!CST_ICMS & Chr(124) & Rs2!CFOP & Chr(124) & Rs2!ALIQ_ICMS & Chr(124)
Rs1.MoveNext:Rs2.MoveNext
Loop
End If

Close #1

Rs2.Close:Rs1.Close
Set Rs1 = Nothing:Set Rs2 = Nothing
End SUB

Alexandre Obrigado pela resposta, mas acabei percebendo que coloquei de forma incompleta a minha questão, pois na formação desse arquivo pode ocorrer que para cada C100 pode ter mais de um C190 o que deixaria incorreto o arquivo, pode ajudar, pois o código que você enviou ele preenche um registro de cada um.

Postei o arquivo com esse cenário, se puder ajudar, por isso que no código anterior estava tentando fazer com que o Rs2 verifica-se sempre o Rs1,mas também tem outro porem, é que o C190 referente ao C100 não pode ter registro repetidos, ou seja, registro que ja constam no arquivo.

C100 - NF1
C190 - NF1
C190 - NF1
C190 - NF1
C100 - NF2
C190 - NF2
C100 - NF3
C190 - NF3

Vê se é isso:

Código:

Function Gerar()

Dim Rs1 As DAO.Recordset, Rs2 As DAO.Recordset
Dim caminho As String
Dim fso

'Verifica se existe pasta C:\
Set fso = CreateObject("Scripting.FileSystemObject")
If Not fso.FolderExists("C:\Arquivos_Teste") Then ' verifica se já existe a pasta
    MkDir "C:\Arquivos_Teste" ' se não existir cria
End If

caminho = "C:\Arquivos_Teste\" & "TESTE.txt"
Open caminho For Output As #1

Set Rs1 = CurrentDb.OpenRecordset("SELECT * FROM TBL_C100_S;")
Do While Not Rs1.EOF
    Print #1, Chr(124) & Rs1!REG & Chr(124) & Rs1!IND_OPER & Chr(124) & Rs1!IND_EMIT & Chr(124) & Rs1!COD_PART & Chr(124)
    Set Rs2 = CurrentDb.OpenRecordset("SELECT * FROM TBL_C190_S WHERE ID_NF = " & Rs1!ID_NF)
    Do Until Rs2.EOF
        Print #1, Chr(124) & Rs2!REG & Chr(124) & Rs2!CST_ICMS & Chr(124) & Rs2!CFOP & Chr(124) & Rs2!ALIQ_ICMS & Chr(124)
        Rs2.MoveNext
    Loop
    Rs1.MoveNext
Loop

Close #1

Rs1.Close
Rs2.Close
Set Rs1 = Nothing: Set Rs2 = Nothing

End Function

Só não entendi como identificar duplicidade de C190, aparentemente poderiam existir dois ou mais registros idênticos se referindo a itens distintos. Ou seja, qual seria o campo (ou campos) em C190 que não pode se repetir dentro do mesmo C100?

Muito Obrigado Claudio, era isso mesmo e ta funcionando certinho agora...O código como esta rodando é exatamente o que estava imaginando e evitando duplicidade de registro.

Att,

Luis