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