Boa tarde!
Tenho uma rotina que utilizo para importação de dados, mas durante a importação alguns caracteres não são reconhecidos. Pesquisei e vi que tem relação com o código de paginação, mas não consegui revolver o problema.
Alguns erros apresentados:
Matuzal,m = Matuzalém
SÆo Pedro = São Pedro
Segue o código utilizado:
SO - Win10 - Access 2016
Tenho uma rotina que utilizo para importação de dados, mas durante a importação alguns caracteres não são reconhecidos. Pesquisei e vi que tem relação com o código de paginação, mas não consegui revolver o problema.
Alguns erros apresentados:
Matuzal,m = Matuzalém
SÆo Pedro = São Pedro
Segue o código utilizado:
- Código:
Public Function AbriRC()
' Requer referencia a Microsoft Office 11 Object Library
On Error GoTo PROC_ERR
Dim fd As FileDialog
Set fd = Application.FileDialog(msoFileDialogFilePicker)
fd.Title = "Selecione o arquivo base de Protocolo"
fd.Filters.Add "Base GIS", "*.dbf, *.xlsx", 1
fd.Show
If (fd.SelectedItems.Count > 0) Then
'------inicio importação excel para sincronização
Dim strPathFile As String, strFile As String, strPath As String
Dim strTable As String
Dim FileName As String
Dim Dir1 As String
'Dim blnHasFieldNames As Boolean
Dim db As DAO.Database
Dim tbl As DAO.TableDef
Dim cpo As DAO.Field
Dim nbTypeFile As Integer
'blnHasFieldNames = True
Dir1 = Left(fd.SelectedItems(1), (Len(fd.SelectedItems(1)) - Len(strFile)))
strPathFile = fd.SelectedItems(1)
strPath = CurrentProject.Path
strTable = "FromDBF"
strFile = Dir(fd.SelectedItems(1))
nbTypeFile = InStr(1, Right(strFile, 5), ".") 'Tipo de Arquivos (1=DBF 2=Excel)
'MsgBox Left(fd.SelectedItems(1), (Len(fd.SelectedItems(1)) - Len(strFile) - 1)) & " / " & strFile ' Teste
'apaga temporarios
'DoCmd.RunSQL "Delete * from [FromDBF]"
DoCmd.DeleteObject acTable, strTable
'On Error Resume Next
'importa para tabela local temporária
'Formato XLSX ACRESCETAR A TABELA EXISTENTE
'DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, strTable, strPathFile, blnHasFieldNames
'Formato DBF Importando dados
DoCmd.TransferDatabase TransferType:=acImport, DatabaseType:="dBASE III", DatabaseName:=Left(fd.SelectedItems(1), (Len(fd.SelectedItems(1)) - Len(strFile) - 1)), ObjectType:=acTable, Source:=strFile, Destination:=strTable
'Executando Consultas Criar Tabela e inserindo as chaves primárias
DoCmd.SetWarnings (WarbingsOff)
DoCmd.OpenQuery "CriarTalhao", acViewNormal, acEdit
CurrentDb.Execute ("Alter Table BaseTalhao ADD COLUMN cd_id1 AutoIncrement;")
DoCmd.OpenQuery "CriarParcelas", acViewNormal, acEdit
CurrentDb.Execute ("Alter Table BaseParcelas ADD COLUMN cd_id2 AutoIncrement;")
DoCmd.SetWarnings (WarbingsOn)
'Formato CSV
'DoCmd.TransferText TransferType:=acImportDelim, _
TableName:="strTable", hasfieldnames:=True, FileName:=strPathFile
'DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel8, strTable, strPathFile, blnHasFieldNames
'sql verifica existentes e marca com não novo
'DoCmd.OpenQuery "xls01marcaExistentes", acViewNormal, acEdit
'sql atualiza existentes
'DoCmd.OpenQuery "xls02AtualizaExistentes", acViewNormal, acEdit
'sql lança novos no ficheiro funcionarios
'DoCmd.OpenQuery "xls03LancaNovos", acViewNormal, acEdit
MsgBox "Operação concluída.", vbInformation, ""
'apaga temporarios
'DoCmd.RunSQL "Delete * from [Dados Coletor]"
Else
MsgBox "Não foi escolhido nenhum ficheiro", vbInformation, ""
End If
PROC_EXIT:
Exit Function
PROC_ERR:
DoCmd.Hourglass False
If Err.Number = 3011 Then
LocalXML = ""
MsgBox ("Ficheiro inválido. Verifique se no nome do arquivo existe espaços em branco, algum caractere especial (- / _ & @) ou se o formato do arquivo está correto.")
'Cria uma tabela
Set db = CurrentDb
Set tbl = db.CreateTableDef("FromDBF")
Set cpo = tbl.CreateField("cData", dbDate)
tbl.Fields.Append cpo
db.TableDefs.Append tbl
db.TableDefs.Refresh
Else
MsgBox Err.Description
End If
Resume PROC_EXIT
End Function
SO - Win10 - Access 2016