[Resolvido]Escrever Log em ListBox dos dados contidos em um recordset

Tópico divido, referente a dúvida do colega Nardiron Nunes

Harysohn testei mas nao funcionou
eu queria aquela tela de log da seu programa de biometria igual a essa imagem pois to querendo mostrar os itens importados da minha nota fiscal...

Nardiron, as funções são estas:

No Módulo do form coloque esta função
´-----------------------------------------------------------------
'Escreve log's em listBox no Form
Private Sub EscreveLog(msg As String)
' adiciona menssagem
Me.Sualista.RowSource = Me.Sualista.RowSource & msg & ";"
Me.Sualista = Me.suaista.ItemData(Me.Sualista.ListCount() - 1)
Exit Sub
'-----------------------------------------------------------------



´---------------------------------------------------------------------------
'E no procedimento que carrega os dados, vais executando a chamada da função
'Se for em loop, a cada loop ela vai carregando a list
'Neste exemplo esta adicionando dois campos de um recordset e um texto entre ambos..


EscreveLog (Rst!DataAditamento & " Para o funcionario " & Rst!Funcionario)

Nardiron, a lista que exibirá o log ficará no mesmo form deste código?

Vamos la...




Option Compare Database

Private Function ITENS()
Me.Caption = "Importando Itens da Nota Fiscal Eletronica"
Me.msg = "Importando Itens da Nota Fiscal Eletronica"
DoCmd.SetWarnings False
Me.prgTester.Visible = True

Dim lngBigNumber
Dim lngLoopCount
DoCmd.SetWarnings False

Me.TimerInterval = 100
lngBigNumber = 10000
prgTester.Value = 0
prgTester.max = lngBigNumber

DoCmd.OpenForm "FormAviso", acNormal, , , , acDialog

For lngLoopCount = 1 To lngBigNumber
prgTester.Value = lngLoopCount
DoEvents

Next lngLoopCount
Me.TimerInterval = 0
dadosarquivo = AbreXML(arquivo)
NfeXml.TotaldeItens = TotalItensXML(dadosarquivo)
Dim ws As DAO.Workspace
Dim RS, rst As DAO.Recordset
Set ws = DBEngine.Workspaces(0)
Set db = ws.OpenDatabase("c:\CHEKAR\" & "\BDDADOS.mdb", False, False, "MS Access;PWD=senha")
StrSQL = ("SELECT * FROM nff where nnf = '" & N & "'")
Set RS = db.OpenRecordset(StrSQL)

'Set RS = CurrentDb.OpenRecordset("select * from NFF where nnf = '" & n & "'")
If RS.EOF And RS.BOF Then
For I = 1 To NfeXml.TotaldeItens
N = BUSCANO(BUSCANO(dadosarquivo, "ide"), "nNF")
cODIGO = BUSCANO(BUSCANO(dadosarquivo, "det nitem=" & Chr(34) & I & Chr(34)), "cprod")
descricao = BUSCANO(BUSCANO(dadosarquivo, "det nitem=" & Chr(34) & I & Chr(34)), "Xprod")
NCM = BUSCANO(BUSCANO(dadosarquivo, "det nitem=" & Chr(34) & I & Chr(34)), "NCM")
CFOP = BUSCANO(BUSCANO(dadosarquivo, "det nitem=" & Chr(34) & I & Chr(34)), "CFOP")
Uni = BUSCANO(BUSCANO(dadosarquivo, "det nitem=" & Chr(34) & I & Chr(34)), "UCOM")
QUANT = Replace(BUSCANO(BUSCANO(dadosarquivo, "det nitem=" & Chr(34) & I & Chr(34)), "QCOM"), ".", ",")
VUNI = Replace(BUSCANO(BUSCANO(dadosarquivo, "det nitem=" & Chr(34) & I & Chr(34)), "VUNCOM"), ".", ",")
vTotal = Replace(BUSCANO(BUSCANO(dadosarquivo, "det nitem=" & Chr(34) & I & Chr(34)), "Vprod"), ".", ",")
desc = Replace(BUSCANO(BUSCANO(dadosarquivo, "det nitem=" & Chr(34) & I & Chr(34)), "VDESC"), ".", ",")
'iicms = Replace(BUSCANO(BUSCANO(dadosarquivo, "det nitem=" & Chr(34) & I & Chr(34)), "vicms"), ".", ",")
Cst = Replace(BUSCANO(BUSCANO(dadosarquivo, "det nitem=" & Chr(34) & I & Chr(34)), "cst"), ".", ",")
'ibc = Replace(BUSCANO(BUSCANO(dadosarquivo, "det nitem=" & Chr(34) & I & Chr(34)), "vbc"), ".", ",")
aliq = Replace(BUSCANO(BUSCANO(dadosarquivo, "det nitem=" & Chr(34) & I & Chr(34)), "picms"), ".", ",")
If cODIGO = DLookup("[CODIGO]", "[DADOS]") Then
SCODIGO = NCODIGO
Else
SCODIGO = BUSCANO(BUSCANO(dadosarquivo, "det nitem=" & Chr(34) & I & Chr(34)), "cprod")
End If

If Replace(BUSCANO(BUSCANO(dadosarquivo, "ICMSTot=" & Chr(34) & I & Chr(34)), "vicms"), ".", ",") = "0,00" Then
icms = 0
Else
icms = Replace(BUSCANO(BUSCANO(dadosarquivo, "ICMSTot=" & Chr(34) & I & Chr(34)), "vicms"), ".", ",")
End If
If Replace(BUSCANO(BUSCANO(dadosarquivo, "ICMSTot=" & Chr(34) & I & Chr(34)), "vbc"), ".", ",") = "0,00" Then
ibc = 0
Else
ibc = Replace(BUSCANO(BUSCANO(dadosarquivo, "ICMSTot=" & Chr(34) & I & Chr(34)), "vbc"), ".", ",")
End If
DEmissao = BUSCANO(BUSCANO(dadosarquivo, "ide"), "DEMI")
Me.Caption = "" & [descricao] & " - " & [QUANT] & ""

'-------------------------------------------------------
EscreveLog ("Foram adicionados os seguintes registros : ")
Dim x As Integer
For x = 0 To 17
EscreveLog (RS(x))
x = x + 1
Next x
'--------------------------------------------------------
RS.AddNew
RS!cODIGO = SCODIGO
RS!descricao = descricao
RS!Data = Format([DEmissao], "DD/MM/YYYY")
RS!nnf = N
RS!NCM = NCM
RS!CFOP = CFOP
RS!Uni = Uni
RS!VUnit = VUNI
RS!QUANT = QUANT
RS!VDesc = desc
RS!vTotal = (vTotal - desc)
RS!Cst = Cst
RS!VDesc = desc
RS!Alq = aliq
RS!BCIcms = ibc
RS!icms = icms
RS.Update
RS.MoveLast
Next I
'MsgBox "Itens Importado com sucesso!", vbInformation, "IMPORTAR NOTA FISCAL ELETRONICA"
Else
'MsgBox " ITENS JÁ IMPORTADA!", vbExclamation, "IMPORTAR NOTA FISCAL ELETRONICA"
End If
End Function




'Escreve log's em listBox no Form
Private Sub EscreveLog(msg As String)

End Sub
On Error GoTo TrataErro
' adiciona menssagem
lista.RowSource = lista.RowSource & msg & ";"
lista = lista.ItemData(lista.ListCount() - 1)
Exit Sub
TrataErro:
MsgBox Error, , Err
End Sub



Observe o código que adicionei:


'-------------------------------------------------------
EscreveLog ("Foram adicionados os seguintes registros : ")
Dim x As Integer
For x = 0 To 17
EscreveLog (RS(x))
x = x + 1
Next x
'--------------------------------------------------------[/b]

- O primeiro escreve lo, somente escre a frase entre aspas
- Eu contei que adiciona 18 campos, entao defini a variavel x para assumir valor de 0 a 17, que é a quantidade de campos do seu recordset
- Serão 18 loop's sendo que a cada loop a variável x é incrementada em +1
- No segundo escreveLog, vai sendo adicionado na lista o RS + a variável x que assume um numero
RS(0), RS(1), RS(2) etc...


Teste ai... a listBox tem ter o nome Lista.


Cumprimentos.

Tente assim:

EscreveLog (RS(" & x & "))

Tente assim:

Option Compare Database

Private Function ITENS()
Me.Caption = "Importando Itens da Nota Fiscal Eletronica"
Me.msg = "Importando Itens da Nota Fiscal Eletronica"
DoCmd.SetWarnings False
Me.prgTester.Visible = True

Dim lngBigNumber
Dim lngLoopCount
DoCmd.SetWarnings False

Me.TimerInterval = 100
lngBigNumber = 10000
prgTester.Value = 0
prgTester.max = lngBigNumber

DoCmd.OpenForm "FormAviso", acNormal, , , , acDialog

For lngLoopCount = 1 To lngBigNumber
prgTester.Value = lngLoopCount
DoEvents

Next lngLoopCount
Me.TimerInterval = 0
dadosarquivo = AbreXML(arquivo)
NfeXml.TotaldeItens = TotalItensXML(dadosarquivo)
Dim ws As DAO.Workspace
Dim RS, rst As DAO.Recordset
Set ws = DBEngine.Workspaces(0)
Set db = ws.OpenDatabase("c:\CHEKAR\" & "\BDDADOS.mdb", False, False, "MS Access;PWD=senha")
StrSQL = ("SELECT * FROM nff where nnf = '" & N & "'")
Set RS = db.OpenRecordset(StrSQL)

'Set RS = CurrentDb.OpenRecordset("select * from NFF where nnf = '" & n & "'")
If RS.EOF And RS.BOF Then

EscreveLog ("Foram adicionados os seguintes registros : ")

For I = 1 To NfeXml.TotaldeItens
N = BUSCANO(BUSCANO(dadosarquivo, "ide"), "nNF")
EscreveLog (" & N & ")

cODIGO = BUSCANO(BUSCANO(dadosarquivo, "det nitem=" & Chr(34) & I & Chr(34)), "cprod")
EscreveLog (" & CODIGO & ")

descricao = BUSCANO(BUSCANO(dadosarquivo, "det nitem=" & Chr(34) & I & Chr(34)), "Xprod")
NCM = BUSCANO(BUSCANO(dadosarquivo, "det nitem=" & Chr(34) & I & Chr(34)), "NCM")
CFOP = BUSCANO(BUSCANO(dadosarquivo, "det nitem=" & Chr(34) & I & Chr(34)), "CFOP")
Uni = BUSCANO(BUSCANO(dadosarquivo, "det nitem=" & Chr(34) & I & Chr(34)), "UCOM")
QUANT = Replace(BUSCANO(BUSCANO(dadosarquivo, "det nitem=" & Chr(34) & I & Chr(34)), "QCOM"), ".", ",")
VUNI = Replace(BUSCANO(BUSCANO(dadosarquivo, "det nitem=" & Chr(34) & I & Chr(34)), "VUNCOM"), ".", ",")
vTotal = Replace(BUSCANO(BUSCANO(dadosarquivo, "det nitem=" & Chr(34) & I & Chr(34)), "Vprod"), ".", ",")
desc = Replace(BUSCANO(BUSCANO(dadosarquivo, "det nitem=" & Chr(34) & I & Chr(34)), "VDESC"), ".", ",")
'iicms = Replace(BUSCANO(BUSCANO(dadosarquivo, "det nitem=" & Chr(34) & I & Chr(34)), "vicms"), ".", ",")
Cst = Replace(BUSCANO(BUSCANO(dadosarquivo, "det nitem=" & Chr(34) & I & Chr(34)), "cst"), ".", ",")
'ibc = Replace(BUSCANO(BUSCANO(dadosarquivo, "det nitem=" & Chr(34) & I & Chr(34)), "vbc"), ".", ",")
aliq = Replace(BUSCANO(BUSCANO(dadosarquivo, "det nitem=" & Chr(34) & I & Chr(34)), "picms"), ".", ",")
If cODIGO = DLookup("[CODIGO]", "[DADOS]") Then
SCODIGO = NCODIGO
Else
SCODIGO = BUSCANO(BUSCANO(dadosarquivo, "det nitem=" & Chr(34) & I & Chr(34)), "cprod")
End If

If Replace(BUSCANO(BUSCANO(dadosarquivo, "ICMSTot=" & Chr(34) & I & Chr(34)), "vicms"), ".", ",") = "0,00" Then
icms = 0
Else
icms = Replace(BUSCANO(BUSCANO(dadosarquivo, "ICMSTot=" & Chr(34) & I & Chr(34)), "vicms"), ".", ",")
End If
If Replace(BUSCANO(BUSCANO(dadosarquivo, "ICMSTot=" & Chr(34) & I & Chr(34)), "vbc"), ".", ",") = "0,00" Then
ibc = 0
Else
ibc = Replace(BUSCANO(BUSCANO(dadosarquivo, "ICMSTot=" & Chr(34) & I & Chr(34)), "vbc"), ".", ",")
End If
DEmissao = BUSCANO(BUSCANO(dadosarquivo, "ide"), "DEMI")
Me.Caption = "" & [descricao] & " - " & [QUANT] & ""

RS.AddNew
RS!cODIGO = SCODIGO
RS!descricao = descricao
RS!Data = Format([DEmissao], "DD/MM/YYYY")
RS!nnf = N
RS!NCM = NCM
RS!CFOP = CFOP
RS!Uni = Uni
RS!VUnit = VUNI
RS!QUANT = QUANT
RS!VDesc = desc
RS!vTotal = (vTotal - desc)
RS!Cst = Cst
RS!VDesc = desc
RS!Alq = aliq
RS!BCIcms = ibc
RS!icms = icms
RS.Update
RS.MoveLast
Next I
'MsgBox "Itens Importado com sucesso!", vbInformation, "IMPORTAR NOTA FISCAL ELETRONICA"
Else
'MsgBox " ITENS JÁ IMPORTADA!", vbExclamation, "IMPORTAR NOTA FISCAL ELETRONICA"
End If
End Function




'Escreve log's em listBox no Form
Private Sub EscreveLog(msg As String)

End Sub
On Error GoTo TrataErro
' adiciona menssagem
lista.RowSource = lista.RowSource & msg & ";"
lista = lista.ItemData(lista.ListCount() - 1)
Exit Sub
TrataErro:
MsgBox Error, , Err
End Sub

Boas nardiron..

Nova dúvida, novo tópico assim não terminamos por discutir varia soluçõs em apenas um tópico, mantendo assim a qualidade do fórum

Cumprimentos.