| Platform: | Microsoft Access |
| Task: | Import data from a dbf |
| Discussion: | One way to import data into an Access database from a dbf using DoCmd.TransferDatabase. |
| Example: | 'imports a dbf into the database as a table.
'example: ImportDbf "C:\temp","MyFile.dbf","MySurveyID"
Public Sub ImportWaypointsFromDNRGarminShapefile(DBFFilePath As String, DBFFileName As String, SurveyID As String)
On Error GoTo Error:
'!@%$^ing access won't import a filename longer than 8 characters, make a copy of it, name the copy zzz.dbf and import that, then delete it
Dim DbfFile As String
DbfFile = DBFFilePath & "\" & DBFFileName
Dim CopyOfDbfFileName As String
Dim CopyOfDbfFilePath As String
CopyOfDbfFileName = "zzzzzzzz.dbf"
CopyOfDbfFilePath = DBFFilePath & "\" & CopyOfDbfFileName
Dim TemporaryAccessTableName As String
TemporaryAccessTableName = "Z_TemporaryImportedWaypointsTable"
'this sub generates a temporary table to store data from the dbf
'just for good housekeeping try to delete it first in case it didn't get nuked on exit last run
'fails gracefully if the table doesn't exist
DropAccessTable (TemporaryAccessTableName)
'make sure the file exists then copy it to TempDBFFileName
If (FileOrDirExists(DbfFile) = True) Then
'make a copy of the .dbf file
FileCopy DbfFile, CopyOfDbfFilePath
'import the copied dbf file into a temporary access table
DoCmd.TransferDatabase acImport, "dbase IV", DBFFilePath, acTable, CopyOfDbfFileName, TemporaryAccessTableName
'kill the temporary .dbf file
Kill CopyOfDbfFilePath
'get the imported points into a recordset
Dim Sql As String
Dim RS As ADODB.Recordset
Sql = "SELECT * FROM " & TemporaryAccessTableName
Set RS = New ADODB.Recordset
RS.Open Sql, CurrentProject.Connection, adOpenKeyset, adLockReadOnly
'loop through the records and insert them
Do While Not (RS.EOF)
Dim WaypointTime As Date
WaypointTime = CDate(Replace(RS!Time, "-", " ")) 'the replace business is because DNRGarmin sticks a dash in the date that blows up the conversion from date to string
Dim InsertQuery As String
Dim Lat As Double
Lat = RS!Lat
Dim Lon As Double
Lon = RS!Long
Dim Ident As String
Ident = RS!Ident
InsertQuery = "INSERT INTO Locations(SurveyID,LocationName,Type,CaptureDate,Lat,Lon,PointFilename) " & _
"VALUES('" & SurveyID & "','" & Ident & "','Waypoint','" & WaypointTime & "'," & Lat & "," & Lon & ",'" & GetFilenameFromPath(DbfFile) & "');"
Debug.Print InsertQuery & vbNewLine
'RunSQL InsertQuery
RS.MoveNext
Loop
RS.Close
End If
'now get rid of the temporary access table
DropAccessTable (TemporaryAccessTableName)
Exit Sub
Error:
MsgBox Err.Description
End Sub
'drops a table from the database, usually a temporary table
Public Sub DropAccessTable(Tablename As String)
On Error Resume Next
DoCmd.DeleteObject acTable, Tablename
End Sub |