Hi,
I am relatively new to VB and trying to write a CSV import utility that imports data in an Access database.
I have created a form in Access 2007 with two buttons browse and import. The browse button brings up a selection dialog to import the file and the import button imports the data from csv file to the database.
Here's how my code looks like.
Option Compare Database
Dim importFile As String
Private Sub BrowseButton_Click()
Dim fDialog As Office.FileDialog
Dim varFile As Variant
Set fDialog = Application.FileDialog(msoFileDialogFilePicker)
With fDialog
'Allow user to make multiple selections in dialog box.
.AllowMultiSelect = False
'Set the title of the dialog box.
.Title = "Please select one file"
'Clear out the current filters, and add our own.
.Filters.Clear
.Filters.Add "Text files", "*.txt"
If .Show = True Then
'Loop through each file selected and add it to the list box.
For Each varFile In .SelectedItems
'TxtBoxImport has the location of the file to be imported
TxtBoxImport.SetFocus
TxtBoxImport.Text = varFile
Next
End If
End With
End Sub
Private Sub ImportButton_Click()
Const adOpenStatic = 3
Const adLockOptimistic = 3
Const ForReading = 1
Dim recordExits As Boolean
Dim noRecords As Integer
Dim logFile As String
Dim currentTime As String
Dim hour As String
Dim minute As String
Dim second As String
hour = DatePart("h", Now)
minute = DatePart("m", Now)
second = DatePart("s", Now)
currentTime = Format(Now(), "yyyymmdd")
'create logfile with timestamp
logFile = CurrentProject.Path & "\DataImportLog - " & currentTime & "_" & hour & minute & second & " PM.txt"
MsgBox (logFile)
Open logFile For Output As #1
'logfile to write logs into, just printed hello world atm
Print #1, "Hello world"
Close
Set objConnection = CreateObject("ADODB.Connection")
Set objrecordset = CreateObject("ADODB.Recordset")
'open connection to the database
objConnection.Open _
"Provider = Microsoft.Jet.OLEDB.4.0; " & _
"Data Source = H:\MCA.mdb"
objrecordset.Open "SELECT * FROM MCATable", _
objConnection, adOpenStatic, adLockOptimistic
Set objFSO = CreateObject("Scripting.FileSystemObject")
TxtBoxImport.SetFocus
importFile = TxtBoxImport.Text
'open the csv file to be imported
Set objFile = objFSO.OpenTextFile(importFile)
noRecords = 0
Do Until objFile.AtEndOfStream
'read from the text file
strPatient = objFile.ReadLine
attrPatient = Split(strPatient, ",")
objrecordset.MoveFirst
recordExits = False
'check for duplicate records
Do Until objrecordset.EOF
If objrecordset!Name = attrPatient(0) Then
recordExits = True
Exit Do
End If
objrecordset.MoveNext
Loop
'if no duplicates, write record to file
If recordExits = False Then
noRecords = noRecords + 1
objrecordset.MoveLast
objrecordset.AddNew
objrecordset("Name") = attrPatient(0)
objrecordset("Department") = attrPatient(1)
objrecordset.Update
End If
Loop
answer = MsgBox("Successfully imported " & noRecords & " records. View Log?", vbInformation + vbYesNo, "Data Import Utility")
If answer = vbYes Then
'implement the display of file
End If
objrecordset.Close
objConnection.Close
End Sub
The code works fine but I need help finding bugs in this. Also how can I do exception handling in VB say a csv with wrong format is selected the program must not terminate abruptly but handle the exception.
Also I get a Runtime error at times which says
"The database has been placed in a sate by user 'Admin' on machine 'machinename' that prevents it from being opened or locked"
On clicking debug it points to this line
objConnection.Open _
"Provider = Microsoft.Jet.OLEDB.4.0; " & _
"Data Source = H:\MCA.mdb"
Am I doing something wrong here? The error goes away once I restart access but reappears in a while.
Thanks.