# VBForums CodeBank > CodeBank - Other >  Create Access database and load new table from CSV.

## jeffjohnvol

I was trying to find an example of this earlier and didn't, so I rolled my own.  I wanted to share it for anyone else on the web looking.  I wrote it in Excel VBA, but I suppose it could work in general VB.

It essentially takes any random CSV with a (1st) row of unique titles and builds an access database with a single table.

Requirements: 
you need a db name (an accdb extension)the CSV header (1st row)  will be field names, spaces replaced with underscores. (I know some people say underscores are bad, but I don't think they're used to working with real databases (Oracle, et, al) .  :Wink:  )I run this on Excel 2016, YMMV with your version.Replace the "Newest_File" function with your CSV file name or equivalent.  (that function wasn't written by me so I didn't want to post someone elses work).

Also note that this sub:
I wrote this to blow away my old access db and build fresh.  *Be aware, it deletes first.*Makes all columns strings.  You can tweak it to figure out numbers if you like.It looks at the max value of each column to determine the size to make it.  If a column is all blank, size will be 1.It adds a "dummy" field at the end which just saves me some formatting code (I was lazy).Change the table to fit your needs.  I made mine 'assets'.The ParseString function is one of my favorites.  I wrote it 17 years ago and still use it.  There may be a modern equivalent that I don't know about.I didn't make this thing "perfect" and commented for this posting, but it does what I need.

Hope it helps someone.
-Jeff



```
Sub CreateDB(dbPath As String)

   Dim dbConnectStr As String
   Dim Catalog As Object
   Dim cnt As Object

    BuildLog ("Rebuilding Database from CSV File")


    dbConnectStr = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & dbPath & ";"

    BuildLog ("    Deleting old database")
    On Error Resume Next
    Kill dbPath
    On Error GoTo 0

   Dim dbs As Object
   Set dbs = CreateObject("ADOX.Catalog")
   dbs.Create "provider='Microsoft.ACE.OLEDB.12.0';Data Source=" & dbPath
   Set dbs = Nothing

    
    CSV_Path = "C:\Users\Jeff\Downloads\"
    CSV_File = CSV_Path & NewestFile("C:\Users\Jeff\Downloads", "asset*.csv")
    BuildLog ("    Opening Source file " & CSV_File)

    iFileNum = FreeFile()
    Open CSV_File For Input As iFileNum

    Line Input #iFileNum, strFields
    i = 0
    Do While 1 = 1
      i = i + 1
      strField = ParseString(strFields, ",", i)
      If strField = "" Then
        intFldCnt = i - 1
        Exit Do
      End If
    Loop
    Dim arrFields() As String
    Dim arrSizes() As Integer
    ReDim arrFields(intFldCnt)
    ReDim arrSizes(intFldCnt)
    For i = 1 To intFldCnt
      strField = Replace(ParseString(strFields, ",", i), " ", "_")
      arrFields(i) = strField
    Next

    intRowCnt = 0
    Dim arrValues()
    ReDim arrValues(500, intFldCnt)
    Do While Not EOF(iFileNum)
      intRowCnt = intRowCnt + 1
      Line Input #iFileNum, CSV_Row_Line
      For j = 1 To intFldCnt
        arrValues(intRowCnt, j) = Replace(ParseString(CSV_Row_Line, ",", j), "'", "''")
      Next
    Loop

    ' Get the max length of each column, so we know what arrSizes to make our columns
    Close iFileNum
    For intCol = 1 To intFldCnt
      For intRow = 1 To intRowCnt
        If Len(arrValues(intRow, intCol)) > arrSizes(intCol) - 1 Then ' the -1 BS has it evaluate those of zero len, so we get at least 1
          arrSizes(intCol) = Len(arrValues(intRow, intCol)) + 1
        End If
      Next
    Next
    strCreateTbl = "CREATE TABLE ASSETS ("
    For intCol = 1 To intFldCnt
      strCreateTbl = strCreateTbl & "[" & arrFields(intCol) & "] text(" & arrSizes(intCol) & "), "
    Next
    strCreateTbl = strCreateTbl & "[dummy] text(1) ) "
  
    'Open the database and create the table
    Set cnt = CreateObject("ADODB.Connection")
    cnt.Open "Provider=Microsoft.ACE.OLEDB.12.0; Data Source=" & dbPath & ";"
    cnt.Execute strCreateTbl
    

    'Insert data into our tables
    For intRow = 1 To intRowCnt
      strInsertStmt = "INSERT INTO ASSETS VALUES("
      For intCol = 1 To intFldCnt
        strInsertStmt = strInsertStmt & "'" & arrValues(intRow, intCol) & "',"
      Next
      strInsertStmt = strInsertStmt & "'X')"
      cnt.Execute strInsertStmt
    Next


Set cnt = Nothing
End Sub

Public Function ParseString(InString, Delimchar, SegPosition)

  PosCnt = 0
  Pos1 = 1
  Do While PosCnt <= SegPosition
    PosCnt = PosCnt + 1
    Pos2 = Pos1
    Pos2 = InStr(Pos1, InString & Delimchar, Delimchar)
    If Pos2 > 0 Then
        If PosCnt = SegPosition Then
          OutString = Mid(InString, Pos1, (Pos2 - Pos1))
          Exit Do
        End If
      Pos1 = Pos2 + 1
    Else
      OutString = ""
      Exit Do
    End If
  Loop
  ParseString = OutString

End Function
```

----------

