-
Feb 12th, 2018, 01:37 PM
#1
Thread Starter
New Member
Create Access database and load new table from CSV.
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) . )
- 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
Code:
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
Posting Permissions
- You may not post new threads
- You may not post replies
- You may not post attachments
- You may not edit your posts
-
Forum Rules
|
Click Here to Expand Forum to Full Width
|