Fazer tratativa antes de importar do excel para o access

Moderador: Avelino Sampaio

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

Fazer tratativa antes de importar do excel para o access

Mensagempor Carvalho » 11 Jan 2018, 14:39

bom dia pessoal,

tenho essa função que o Damasceno me passou e está me atendendo muito bem, porem veio uma bronca agora, antes de trazer do excel para o access ele tem que fazer uma tratativa no campo "fase" fanzendo um mid e dai trazer correto pois o campo fase do access é número e eles agora estão colocando texto e numero nesse campo do excel!

segue o código que estou usando:

em vermelho é onde estou tentando adaptar para corrigir esse problema!

'linha onde estou tentando corrigir esse erro If strCampo = "fase" Then rs2(strCampo).Value = Val(Mid(fld.Value, 1, 2)) Else

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", "Atualizar") [color=#008040]'variável com o maior código IdSistema
    Set bdExcel = OpenDatabase("Y:\PCP\10 - Controles\20 - Aframax\30 - Montagem\BD C013.xlsb", False, True, "Excel 12.0;HDR=Yes;IMEX=1") 'abro o arquivo excel
    Set rs1 = bdExcel.OpenRecordset("BD$") 'abro a planilha
    Set rs2 = CurrentDb.OpenRecordset("select * from Atualizar 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("3").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)
'                            If strCampo <> "" Then rs2(strCampo).Value = fld.Value
'                        Next fld
'                    rs2.Update
                    rs1.MoveNext
                    If rs1.EOF Then Exit Do
                ElseIf CDbl(rs1("3").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
                        If fld.Name = "F118" Then Exit For
                            strCampo = fncEquivale(fld.Name)
                        If strCampo = "fase" Then rs2(strCampo).Value = Val(Mid(fld.Value, 1, 2)) Else  'aqui é onde estou tentando corrigir esse erro
                       
                            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)
 '               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 1 visitante