[Resolvido]Percorrer tabela e atualizar campos em cada registro

Buenas!
Copiei o código que contou com a ajuda do Alexandre Neves, aqui no fórum, tentei adaptá-lo mas não consegui.
O problema é o seguinte:
1) Tenho uma Tabela (TabNomeArquivo) onde há um campo NomeArquivo e outros mais - Campo1, Campo2, Campo3 ... Campo6;
2) O NomeArquivo tem informações que vão alimentar os Campos1 ... Campo6, separadas por underline ("_");
3) Preciso ler todos os campos NomeArquivo, extrair as informações e colocar nos respectivos campos.

A extração das informações está funcionando, há a separação das informações e elas vão para os campos corretamente. Mas os campos são alimentados, para todos os NomeArquivo, com as informações de um único NomeArquivo. Ou seja, lê todos os registros mas usa as informações de um só.
Certamente, há um erro de loop, mas não enxergo.

Eis o código:

Function SeparaCampos()
 Dim VNomeArquivo As String
 Dim VPosicaoUnderline As Variant
 Dim i As Integer
 
'-----------------------------------------------------------------------
Dim db As DAO.DataBase
Dim rs As DAO.Recordset

Set db = CurrentDb
Set rs = db.OpenRecordset("TabNomeArquivo")

 Do While Not rs.EOF
   VNomeArquivo = rs("NomeArquivo")
   
   VPosicaoUnderline = Split(VNomeArquivo , "_")
     
     For i = 0 To UBound(VPosicaoUnderline)
     
       Select Case i
         Case 0
            CurrentDb.Execute "TabNomeArquivo SET Campo1 = '" & VPosicaoUnderline(i) & "';"
         Case 1
            CurrentDb.Execute "TabNomeArquivo SET Campo2 = '" & VPosicaoUnderline(i) & "';"
         Case 2
            CurrentDb.Execute "TabNomeArquivo SET Campo3 = '" & VPosicaoUnderline(i) & "';"
         Case 3
            CurrentDb.Execute "TabNomeArquivo SET Campo4 = '" & VPosicaoUnderline(i) & "';"
         Case 4
            CurrentDb.Execute "TabNomeArquivo SET Campo5 = '" & VPosicaoUnderline(i) & "';"
         Case 5
            CurrentDb.Execute "TabNomeArquivo SET Campo6 = '" & VPosicaoUnderline(i) & "';"
       
         Case Else
       End Select
       
      i = i + 1
   

     Next
   
   rs.MoveNext
   
   Loop
 

End Function

Tem como postar um exemplo da seu projeto?

A tabela deveria ser alimentada dessa forma:

NomeArquivo................................................Campo1........Campo2........Campo3........Campo4........Campo5........Campo6
Oficio_SP_SaoPaulo_001234_003_20141103.......Oficio............SP...............SaoPaulo.......001234........003.............20141103
Memorando_BA_Salvador_001257_002_20141103....Memorando.........BA.......Salvador.........001257.........002......... 20141103
Circular_SP_Diadema_001298_008_20141103........Circular.........SP........Diadema........001298.........008.........20141103
OrdemServico_SP_SaoPaulo_001241_001_20140820.....OrdemServico.....SP.....SaoPaulo.....001241.....001.....20140820


Mas fica assim:

NomeArquivo................................................Campo1........Campo2........Campo3........Campo4........Campo5........Campo6
Oficio_SP_SaoPaulo_001234_003_20141103.....OrdemServico.....SP.....SaoPaulo.....001241.....001.....20140820
Memorando_BA_Salvador_001257_002_20141103.....OrdemServico.....SP.....SaoPaulo.....001241.....001.....20140820
Circular_SP_Diadema_001298_008_20141103.....OrdemServico.....SP.....SaoPaulo.....001241.....001.....20140820
OrdemServico_SP_SaoPaulo_001241_001_20140820.....OrdemServico.....SP.....SaoPaulo.....001241.....001.....20140820


Veja que os campos são preenchidos com as informações do último registro da tabela.
Lembrando que a primeira coluna já existe na tabela antes de executar o código. Dela saem os valores para as demais.

Luis

Experimente adicionar a linha em vermelho no código:

Function SeparaCampos()
Dim VNomeArquivo As String
Dim VPosicaoUnderline As Variant
Dim i As Integer

'-----------------------------------------------------------------------
Dim db As DAO.DataBase
Dim rs As DAO.Recordset

Set db = CurrentDb
Set rs = db.OpenRecordset("TabNomeArquivo")

rs.movefirst ' coloca o ponteiro no primeiro registro da tabela

Do While Not rs.EOF
  VNomeArquivo = rs("NomeArquivo")
 
  VPosicaoUnderline = Split(VNomeArquivo , "_")
   
   

Abraços

Noob

Noob, coloquei e não adiantou. Nesse tempo alterei o For...Next para While.. Loop, mas deu na mesma; agora repete as informações do primeiro registro.


rs.MoveFirst

Do While Not rs.EOF
  VNomeArquivo = rs("NomeArquivo")
 
  VPosicaoUnderline = Split(VNomeArquivo , "_")
   
   ' For i = 0 To UBound(VPosicaoUnderline)
    Do While i <= UBound(VPosicaoUnderline)
   
      Select Case i
        Case 0
           CurrentDb.Execute "TabNomeArquivo SET Campo1 = '" & VPosicaoUnderline(i) & "';"
        Case 1
           CurrentDb.Execute "TabNomeArquivo SET Campo2 = '" & VPosicaoUnderline(i) & "';"
        Case 2
           CurrentDb.Execute "TabNomeArquivo SET Campo3 = '" & VPosicaoUnderline(i) & "';"
        Case 3
           CurrentDb.Execute "TabNomeArquivo SET Campo4 = '" & VPosicaoUnderline(i) & "';"
        Case 4
           CurrentDb.Execute "TabNomeArquivo SET Campo5 = '" & VPosicaoUnderline(i) & "';"
        Case 5
           CurrentDb.Execute "TabNomeArquivo SET Campo6 = '" & VPosicaoUnderline(i) & "';"
     
        Case Else
      End Select
     
     i = i + 1
 

    'Next
    Loop
 
  rs.MoveNext
 
  Loop

Fiz um teste, saindo fora do segundo While e antes do rs.MoveNext, , ou seja, não indo para o próximo registro, mas vi que todos os registros foram preenchidos. Portanto há um erro de loop. Não está havendo uma subordinação do segundo While ao primeiro.

Luis

Teste para ver se percorre todos os registros da tabela:

Código:



Function SeparaCampos()
 Dim VNomeArquivo As String
 Dim VPosicaoUnderline As Variant
 Dim i As Integer
 
'-----------------------------------------------------------------------
Dim db As DAO.Database
Dim rs As DAO.Recordset

Set db = CurrentDb
Set rs = db.OpenRecordset("TabNomeArquivo")
rs.MoveFirst
 Do While Not rs.EOF
   VNomeArquivo = rs("NomeArquivo")
  
   VPosicaoUnderline = Split(VNomeArquivo, "_")
  
   Debug.Print VPosicaoUnderline & vbCrLf  'irá exibir na janela de verificação imediata.
      
   rs.MoveNext
  
   Loop
  

End Function


Veja se exibe todos os registros da tabela na janela de verificação imediata no Visual basic (Crtl +G)

Editando: Tivemos a mesma ideia é?  

Para desencargo de consciência, quantos registros tem nessa tabela?


Noob

Caso ainda não esteja funfando experimente:

Luis - Clique aqui para expandir:

Noob

Não estaria faltando o Update?

CurrentDb.Execute "Update TabNomeArquivo SET Campo1 = '" & VPosicaoUnderline(i) & "';"

Olá Claudio

Pelo que entendi, essa parte está funcionando, o que ele não está conseguindo, é
navegar nos registros da tabela.

Noob

Caraca!
Preocupei-me tanto com o código que esqueci do básico:

      CurrentDb.Execute "Update TabNomeArquivo SET Campo1 = '" & VPosicaoUnderline(i) & "' WHERE NomeArquivo = '" & VNomeArquivo& "';"

e, também :

Do While Not rs.EOF
 
  VNomeArquivo = rs("NomeArquivo")  
  VPosicaoUnderline = Split(VNomeArquivo, "_")
  i = 0 '>>> reiniciar o contador VPosicaoUnderline


Cláudio Más, no meu código tem o update, falha minha quando postei. Bem observado.


Obrigado a todos.

Quantos registros na tabela tblNomeArquivo existem para serem atualizados?

Você quer atualizar ou adicionar?

Júlio, esta tabela é preenchida com o nome de arquivos existentes numa pasta. Esses arquivos são colocados lá diariamente. Então, duas vezes por semana uma rotina captura esses nomes e os adiciona à tabela (TabNomeArquivos, NomeArquivo). O código em questão separa as partes ("_") desse nome e os atualiza na própria tabela :Campo1 a Campo6.

Em média, 150 a 200 registros por semana.

Qual é o código que captura destes arquivos?

Julio, o código que captura o nome na pasta está em outro aplicativo usado em outra área da empresa. Eu recebo a tabela com o nome, e acrescento os outros campos. Vou tentar conseguir o código e coloco aqui. Mas posso adiantar que ele foi pego aqui no fórum.

Olá.

Na verdade não preciso do código. Só preciso verificar se está o seu procedimento está atualizado ou adicionando itens à tabela.

Você não consegue enviar este projeto para nós não? Somente da tabela que quer atualizar, do código que está usando, formulários e a tabela de origem dos nomes que foram gerados pelo outro código.