[resolvido] Update e Insert do excel para o Access não funciona

Moderador: Avelino Sampaio

Avatar do usuário
Carvalho
Mensagens: 143
Registrado em: 21 Ago 2015, 23:22

[resolvido] Update e Insert do excel para o Access não funciona

Mensagempor Carvalho » 06 Abr 2018, 22:22

Boa noite,

Pessoal boa noite, estou a mais de 2 semanas tentando que o código que o Damasceno disponibilizou funcione novamente, ele verifica se o excel tem itens que não tem na tabela inseri esses registros e depois atualiza tudo de acordo com o item da tabela e com a coluna do excel DB, quero entender porque não está funcionando mais, informa que o "o item da coleção não foi encontrado. como mostra a imagem, porem o item existe.

Obs: Para melhor entendimento segue o Bd e o Excel que estou usando. pode abrir o Frm e apertar no botão "antes informar o Local do Excel".


No aguardo.
Você deve estar registrado e autenticado para ter acesso ao arquivo anexo.
Provérbios 1:7 “O temor do SENHOR é o princípio do saber, mas os loucos desprezam a sabedoria e o ensino.”

Disable adblock

Precisamos do seu apoio. Faca uma doacao para o site atraves do Paypal.


Avatar do usuário
Carvalho
Mensagens: 143
Registrado em: 21 Ago 2015, 23:22

Re: Update e Insert do excel para o Access não funciona

Mensagempor Carvalho » 10 Abr 2018, 14:44

Pessoal bom dia,
Alguém poderia me ajudar ? por favor
Provérbios 1:7 “O temor do SENHOR é o princípio do saber, mas os loucos desprezam a sabedoria e o ensino.”

Avatar do usuário
Carvalho
Mensagens: 143
Registrado em: 21 Ago 2015, 23:22

Re:[Resolvido] Update e Insert do excel para o Access não funciona

Mensagempor Carvalho » 20 Abr 2018, 14:54

Pessoal Bom dia,

Consegui resolver em outro fórum "Maximo access", mesmo assim muito obrigado.

Segue abaixo a solução:

Código: Selecionar todos

Public Sub fncImportaExcel()
'On Error Resume Next
    Dim bdExcel As DAO.Database
    Dim Rs1 As Recordset
    Dim Rs2 As Recordset
    Dim fld As Field
    Dim strCampo As String
    Dim lnglimite As Long
   
    lnglimite = DMax("IdSistema", "TbLogistica")
    Set bdExcel = OpenDatabase("C:\Users\Washington.otaviano\Desktop\C013 Insert e Update com o SD\TAG TABELA GERAL.xlsx", False, False, "Excel 12.0;HDR=YES;IMEX=0") 'abro o arquivo excel
    Set Rs1 = bdExcel.OpenRecordset("TAG GERAL$") 'abro a planilha
    Set Rs2 = CurrentDb.OpenRecordset("select * from Tblogistica order by Item;") 'abro a tabela

    Rs1.MoveNext 'avança uma linha
   'rs1.MoveNext 'avança uma linha
  '  rs1.MoveNext 'avança uma linha
  '  rs1.MoveNext 'avança uma linha
   
    Do While Not Rs1.EOF 'loop1, percorrendo todos os registros da planilha
        Do While Not Rs2.EOF 'loop2, percorrendo todos os registros da tabela
            'se o IdSistema da vez for menor ou igual que o limite, então ainda estou
            'mexendo com registros que podem ser editados
            If Rs2("IdSistema") <= lnglimite Then

                If CDbl(Rs1(0).Value) < Rs2("item").Value Then
                'se o menor valor para a coluna Item na planilha for menor que o menor valor para a coluna
                'Item na tabela então este registro precisa ser adicionado
                    Rs2.AddNew
                        For Each fld In Rs1.Fields
                           'strCampo = fncEquivale(fld.Name)
                           strCampo = fncEquivale(fld.OrdinalPosition)
                            If strCampo <> "" Then Rs2(strCampo).Value = fld.Value
                        Next fld
                    Rs2.Update
                    Rs1.MoveNext
                    If Rs1.EOF Then Exit Do
   
                ElseIf CDbl(Rs1(0).Value) > Rs2("Item").Value Then
                'se o menor valor para a coluna Item na planilha for maior que o menor valor para a coluna Item na tabela então
                'apenas vou para o próximo registro
                    Rs2.MoveNext
                Else 'senão, ou seja, se os valores na coluna Item da planilha e Item na tabela forem iguais, edito o registro
                    Rs2.Edit
                        For Each fld In Rs1.Fields
                            'strCampo = fncEquivale(fld.Name)
                            strCampo = fncEquivale(fld.OrdinalPosition)
                            If strCampo <> "" Then Rs2(strCampo).Value = fld.Value
                        Next fld
                    Rs2.Update
                    Rs1.MoveNext
                    Rs2.MoveNext
                    If Rs1.EOF Or Rs2.EOF Then Exit Do
                End If
            Else 'senão, ou seja, se o IdSistema da vez for maior que o limite, então ainda já estou mexendo
                 'com registros que foram adicionados apenas vou para o próximo, ignorando-o
                Rs2.MoveNext
            End If
        Loop
       
        'se cheguei aqui, então há registros na planilha que não existem na tabela cujo
        'valor da coluna Item na planilha é maior que o valor da coluna item na tabela
        'sendo assim, estes precisam ser adicionados
       
        Rs2.AddNew
            For Each fld In Rs1.Fields
                'strCampo = fncEquivale(fld.Name)
                strCampo = fncEquivale(fld.OrdinalPosition)
                If strCampo <> "" Then Rs2(strCampo).Value = fld.Value
            Next fld
        Rs2.Update
        Rs1.MoveNext
       
    Loop
   
    Rs1.Close
    Set Rs1 = Nothing
    bdExcel.Close
    Set bdExcel = Nothing
    Rs2.Close
    Set Rs2 = Nothing




    MsgBox "Sistema Atualizado com sucesso!", vbInformation, "Aviso"

End Sub
Provérbios 1:7 “O temor do SENHOR é o princípio do saber, mas os loucos desprezam a sabedoria e o ensino.”

Disable adblock

Precisamos do seu apoio. Faca uma doacao para o site atraves do Paypal.



Voltar para “Access x Excel”

Quem está online

Usuários neste fórum: Nenhum usuário registrado e 2 visitantes