Início
![[Resolvido]Erro de conversão de tipos - RecordSet Empty](https://2img.net/i/empty.gif)
gabrielpn06 Qua 01 Ago 2018, 09:31Bom dia amigos,
Tenho um código onde importo campos de uma tabela via RecordSet.
O Código funciona bem, desde que em campos do tipo "moeda" o valor não seja "R$ - 0,00" ou "R$ - ".
Teria alguma forma de eu usar o Format() assim como fiz no campo de datas? Se sim, como ficaria? Desde já agradeço!
Segue o código:
Tenho um código onde importo campos de uma tabela via RecordSet.
O Código funciona bem, desde que em campos do tipo "moeda" o valor não seja "R$ - 0,00" ou "R$ - ".
Teria alguma forma de eu usar o Format() assim como fiz no campo de datas? Se sim, como ficaria? Desde já agradeço!
Segue o código:
- Código:
Public Function ImportRetorno()
On Error GoTo trataErro
Dim dbLocal As DAO.Database
Dim myRec As DAO.Recordset
Dim dbExcel As DAO.Database
Dim rsExcel As DAO.Recordset
Dim rsTable As DAO.Recordset
Dim Planilha As String
Dim QtdRegistros As Long
Dim coluna As String
Dim QtdRegNaoCarregados As Long
Dim strSQL As String
Dim xlPath As String
Dim ARQUIVO As Variant
Dim Steps As Integer
Dim CountSteps As Integer
Dim intRecordCount As Integer
Dim Celula As String
Dim FileNameTextBoxTo As String
Dim vVerifica As String
Steps = 1
CountSteps = 1
Set myRec = CurrentDb.OpenRecordset("tb_ImpRetorno")
Set dbLocal = CurrentDb
dbLocal.Execute "DELETE * FROM tb_ImpRetorno"
xlPath = CurrentProject.Path & "\Input\Retorno\"
ARQUIVO = xlPath & "Pendências.xlsx"
'"Pendências" &
If (ARQUIVO = "") Then
MsgBox "Não há arquivos para processar! Por favor, verifique se os arquivos estão no formato .XLSX. Interrompendo processamento.", vbExclamation, "Falha no processamento"
Exit Function
Else
Forms!frm_Main!lblStatus = "Importação em andamento..."
'declara o caminho e novo da base a ser importada
Planilha = ARQUIVO
Set dbExcel = OpenDatabase(Planilha, False, True, "Excel 8.0; HDR=no; IMEX=1;")
Set rsExcel = dbExcel.OpenRecordset("Base Pendências$") 'define o nome da sheet da planilha
'move para próxima linha, para pular o cabeçalho
rsExcel.MoveNext
'delara o valor dos contadores
QtdRegistros = 0
QtdRegNaoCarregados = 0
Do While Not rsExcel.EOF
1 myRec.AddNew
coluna = "Chave"
myRec.Fields("Chave") = Trim(rsExcel.Fields("F1")) & Format(Trim(rsExcel.Fields("F2")), "dd/mm/yyyy")
coluna = "ID BASE"
myRec.Fields("ID BASE") = Trim(rsExcel.Fields("F1"))
coluna = "DATA DE ENVIO"
myRec.Fields("DATA DE ENVIO") = Format(Trim(rsExcel.Fields("F2")), "dd/mm/yyyy")
coluna = "VALOR DA TARIFA"
myRec.Fields("VALOR DA TARIFA") = Trim(rsExcel.Fields("F9")) '<----- nesse da erro
coluna = "IR"
myRec.Fields("IR") = Trim(rsExcel.Fields("F10")) '<----- nesse da erro
myRec.Update
QtdRegistros = QtdRegistros + 1
'Read records and process data
rsExcel.MoveNext
Loop
'fecha o recordset do excel
rsExcel.Close
Set rsExcel = Nothing
dbExcel.Close
Set dbExcel = Nothing
CountSteps = CountSteps + 1
End If
'fecha o recordset da tabela local
dbLocal.Close
Set dbLocal = Nothing
'APAGA ARQUIVOS DAS PASTAS DE INPUT
Do Until Dir(CurrentProject.Path & "\Input\Retorno\" & "*.xlsx") = ""
VBA.Kill (CurrentProject.Path & "\Input\Retorno\" & "*.xlsx")
Loop
Forms!frm_Main!lblStatus = "Importação das bases de envio concluída com sucesso!"
Exit Function
trataErro:
Forms!frm_Main!lblStatus = "Ocorreu um erro na importação das bases de retorno!"
If (Err.Number = 3022) Then
QtdRegistros = QtdRegistros + 1
rsExcel.MoveNext
GoTo 1
ElseIf (Err.Number = 3125) Then
MsgBox "Nome da planilha é diferente de Sheet1. Favor corrigir e reimportar o arquivo.", vbExclamation
ElseIf (Err.Number = 3421) Then
MsgBox "Foi apresentado um erro de formatação na linha " & QtdRegistros & " da coluna " & coluna & "!", vbCritical
ElseIf (Err.Number = 13) Then
MsgBox "Foi apresentado um erro de formatação na linha " & QtdRegistros & " da coluna " & coluna & "!", vbCritical
Else
MsgBox Err.Number & " - " & Err.Description
End If
End Function
