Access 2013 - Dbase (.dbf) Table Import option

it only supports basic types TEXT,MEMO,DATETIME,DOUBLE,YESNO data types.

You can also improve the code to only parameter the directory path then all the dbf files on that directory will be imported to tables on your local access database. would give us ease.

Ok.

1. In your access database, add a new Module (under Database  Tools tab in ribbon)
2. Paste this code then save.

'BEGIN                                                                                                                         

Function ImportDBF(ByVal dbfFileDir As String, _

                    ByVal dbfTableName As String)

    dbfFileDir = dbfFileDir & "\"

    Dim dbfCn As Object

    Dim dbfRs As Object

    Dim dbfStrSql As String

    Dim dbfStrConnection As String

    Set dbfCn = CreateObject("ADODB.Connection")

    dbfStrConnection = "Provider=Microsoft.Jet.OLEDB.4.0;" & _

        "Data Source=" & dbfFileDir & ";" & _

        "Extended Properties=dBase IV"

    dbfStrSql = "SELECT * FROM " & dbfTableName & ""

    dbfCn.Open dbfStrConnection

    Set dbfRs = dbfCn.Execute(dbfStrSql)

    Dim fieldIndex As Integer

    Dim ddlNewAccessTable As String

    Dim ddlColumns As String

    Dim dmlInsert As String

    Dim dmlColumns As String

    Dim dmlValues As String

    dmlColumns = "("

    ddlColumns = "("

    For fieldIndex = 0 To dbfRs.Fields.Count - 1

        dmlColumns = dmlColumns & dbfRs.Fields(fieldIndex).Name & ","

        Select Case dbfRs.Fields(fieldIndex).Type

            Case 202

               ddlColumns = ddlColumns & dbfRs.Fields(fieldIndex).Name & " " & _

                            "TEXT,"

            Case 203

                ddlColumns = ddlColumns & dbfRs.Fields(fieldIndex).Name & " " & _

                            "MEMO,"

            Case 5

                ddlColumns = ddlColumns & dbfRs.Fields(fieldIndex).Name & " " & _

                            "DOUBLE,"

            Case 7

                ddlColumns = ddlColumns & dbfRs.Fields(fieldIndex).Name & " " & _

                            "DATETIME,"

            Case 11

                ddlColumns = ddlColumns & dbfRs.Fields(fieldIndex).Name & " " & _

                            "YESNO,"

            Case Else

                ddlColumns = ddlColumns & dbfRs.Fields(fieldIndex).Name & " " & _

                            "TEXT,"

        End Select

    Next fieldIndex

    dmlColumns = Left(dmlColumns, Len(dmlColumns) - 1) & ")"

    ddlColumns = Left(ddlColumns, Len(ddlColumns) - 1) & ")"

    ddlNewAccessTable = "CREATE TABLE " & dbfTableName & " " & ddlColumns & ";"

    Dim myDb As Database

    Set myDb = CurrentDb()

    myDb.Execute ddlNewAccessTable

    Dim fieldIndex2 As Integer

    While Not dbfRs.EOF

    dmlInsert = ""

    dmlValues = "("

        For fieldIndex2 = 0 To dbfRs.Fields.Count - 1

            Select Case dbfRs(fieldIndex2).Type

                Case 202

                     dmlValues = dmlValues & "'" & dbfRs(fieldIndex2).Value & "',"

                Case 203

                    dmlValues = dmlValues & "'" & dbfRs(fieldIndex2).Value & "',"

                Case 5

                    dmlValues = dmlValues & dbfRs(fieldIndex2).Value & ","

                Case 11

                    dmlValues = dmlValues & dbfRs(fieldIndex2).Value & ","

                Case 7

                    If IsDate(dbfRs(fieldIndex2).Value) Then

                        dmlValues = dmlValues & "#" & dbfRs(fieldIndex2).Value & "#,"

                    Else

                        dmlValues = dmlValues & "NULL,"

                    End If

                Case Else

                    dmlValues = dmlValues & "'" & dbfRs(fieldIndex2).Value & "',"

                End Select

        Next fieldIndex2

        dmlValues = Left(dmlValues, Len(dmlValues) - 1) & ")"

        dmlInsert = "INSERT INTO " & dbfTableName & dmlColumns & " VALUES" & dmlValues

        myDb.Execute dmlInsert

        dbfRs.MoveNext

    Wend

    MsgBox "Finished! " & Now

End Function

'END

3. Create a form and add a button (use an event to call this function). Here is a sample:

'You call it like this:

Private Sub Command0_Click()

    ImportDBF "C:\CustomDBFTablesDirectory", "DB_TABLENAME"

End Sub

'It will create a new local access table with name same as your inputted dbftablename

'You can run this without referencing ADO Library

4. A new local table will be added to your access file.

This should work on you.

Anyone can improve this code and share it with us... then the world could be a better place :) hahahah

Thanks. How can we connect that?

Can you please write a step-by-step guide to get it working?