[Resolvido]Atualizando Registros

Ola amigos
Estou com situacao que precisa ser resolvida via VBA. Temos um conjuntos de dados que sao disponibilizados na internet
o banco de dados possui 2 tabelas : Tabela Dados e a Tabela Link
a Dados tem os campos : Codigo - Descricao - Preço - Link
a Link tem o campo Link somente

na primeira tabela temos como exemplo
Codigo    Descricao  Preco   Link
000001 - Camisa - 99,00 -
000002 - Calca - 109,00 -

Na segunda tabela temos os links
Links
https://posting.cc/Mc9TtwPX/000001.jpg
https://posting.cc/Mc9TtwPX/000002.pgn

O que preciso é que o codigo compare o Campo Codigo da tabela Dados e verifique se apos existe uma coincidencia com o campo link da tabela link.
Ou seja caso o codigo da tabela dados esteja presente no link da tabela link que o campo link da tabela Dados seja atualizado resultado nos dados abaixo
Observacao importante é que os codigos nao seguem uma linha de criacao podendo ter varios tamanhos

000001 - Camisa - 99,00 - https://posting.cc/Mc9TtwPX/000001.jpg
000002 - Calca - 109,00 - https://posting.cc/Mc9TtwPX/000002.pgn

nos exemplos acima o codigo 000001 e 000002 estao presente no fim dos links.
Ressalto que os links sempre seguirao este layout de ter os codigos seguidos de alguma extensao de imagem

Ola amigos alguém com alguma saída pra mim !!??

Bom dia.
O que vou passar é um conceito que você pode usar...

Código:


Public Sub cmdComparar()

Dim rs(1 To 2) As DAO.Recordset 'Abre duas consulta em vba
Dim cod As String, url As String, pos As Long

Set rs(1) = CurrentDb.OpenRecordset("SELECT * FROM tblModelo WHERE Link is null") 'Todos os registro que não tem "link"

If Not (rs(1).EOF And rs(1).BOF) Then 'Verifica se não estava vazio

    Set rs(2) = CurrentDb.OpenRecordset("SELECT * FROM imagens") 'Abre a tabela de links
    rs(1).MoveFirst 'Garantir que começe no primeiro registro
    
    Do Until rs(1).EOF = True 'Enquanto não olhar todas as linhas ele não sai
    
        rs(2).MoveFirst 'Toda vez que começar uma linha nova (na tabela 1) volta para o primeiro registro (na tabela 2)
        
            Do Until rs(2).EOF = True 'O mesmo loop só que na segunda tabela
                
                cod= rs(1).Fields("Codigo") 'Código que via ser pesquisado
                url = rs(2).Fields("url") '"url" na tabela 2
                pos = InStr(1, url , cod) 'Olha a se encontrou o texto em alguma "posição" da ulr
                If pos > 0 Then 'encontrar autualiza a tabela
                    rs(1).Edit
                    rs(1).Fields("link") = rs(2).Fields("url")
                    rs(1).Update
                End If

                rs(2).MoveNext 'Vai para a próxima linha da tabela 2
            Loop
        rs(1).MoveNext 'Vai para próxima linha da tabela 1
    Loop
    rs(2).Close: Set rs(2) = Nothing 'Fecha a tabela 2
End If

rs(1).Close: Set rs(1) = Nothing 'Fecha a tabela 1


End Sub


Olha se funciona.

Ola Alyson tentei o codigo que nao deu nenhuma mensagem de erro , mas nao altera nada na tabela. Existe a possibilidade de gerar um pequeno banco e me enviar

Você pode colocar o arquivo no google drive e me liberar o acesso ou eu fazer um acesso remoto na sua maquina para vermos juntos o código.

Claro que eu coloquei o código para você ainda modificar...
Qual o nome da lista de opções para os formulário e a lista esta em uma tabela ou é apenas uma lista para o formulário?

Conecta no any desk se quiser 114 850 099

Ola Alyson to enviando o banco em anexo para dar uma olhada ele e simples

Tentei agora acessar agora o anydesk mais já estava fechada a conexão.

Consegue trabalhar o banco ai ou prefere a conexao

Te a correção de uma linha e já esta ok ai

Poderia passar qual linha alterou so pra eu aprender pois funcionou !!

Eu foi corrigida essa linha que estava comparado informações erradas.

show obrigado
depois me manda seu contato no email leoescritorio@veloxmail.com.br