How to make ADOX write to an Access database in VB.NET 2010?

EDN Admin

Well-known member
Joined
Aug 7, 2010
Messages
12,794
Location
In the Machine
Hello,
Im not sure if this is the right place to post this or not, but Ive already been searching all over the net for an answer, including the forums here, and I cant find an answer to my question. I have been porting an app I wrote in VB6 some time ago over to VB 2010. The app uses ADOX, along--of course with the necessary Imports statements and references--as that is what was used in the previous version of the program and at this point its easier to use what I know rather than reinvent the wheel with ADO.NET. Anyway, my problem is that VB2010 seems to have absolutely no problem whatsoever *reading from* my Access database, but it seems unwilling to even attempt to execute any code whatsoever that involves writing new data *to* the database.
I have debugged the code below every which way from Sunday, and have used Try....Catch statements to try to figure out what the problem is. No errors have been found *at all*; the code simply will not execute. What is supposed to happen is that when btnOK is clicked on my form, the code below *should* create a new record in the database, close the form, and then display a messagebox informing you that the record has been created. What *actually happens* is nothing. When you click the button, the form just sits there and no entry is ever written to the db. Can someone PLEASE help me? Because this is getting frustrating and Im about ready to throw in the towel and go back to VB6, lol! Anyway, heres the code.
Thanks,
Jason
-----
Private Sub CreateProfile()
Try
Dim ProfileName As String = txtUserName.Text
If ProfileExists(ProfileName) = True Then
MsgBox("User Profile " & Chr(34) & ProfileName & Chr(34) & " already exists! Please enter another name.", vbOKOnly, "Error")
If MsgBoxResult.Ok Then
Me.txtUserName.Select()
Me.txtUserName.Text = ""
End If
Exit Sub
ElseIf ProfileExists(ProfileName) = False Then
DBPath = Application.StartupPath & "Profiles.mdb"
SetDB()
con = New ADODB.Connection
With con
.Provider = "Microsoft.Jet.OLEDB.4.0"
.CursorLocation = ADODB.CursorLocationEnum.adUseClient
.Mode = ADODB.ConnectModeEnum.adModeReadWrite
.Open(DBPath)
End With
cmd = New ADODB.Command
With cmd
.ActiveConnection = con
.CommandText = "SELECT * FROM [User_Profiles]"
.CommandType = ADODB.CommandTypeEnum.adCmdText
End With
rec = New ADODB.Recordset
With rec
.CursorType = ADODB.CursorTypeEnum.adOpenStatic
.CursorLocation = ADODB.CursorLocationEnum.adUseClient
.LockType = ADODB.LockTypeEnum.adLockOptimistic
.Open(cmd)
.AddNew()
.Fields("User_Name").Value = txtUserName.Text
If chkPassword.Checked = True Then
.Fields("Password_Protection_Enabled").Value = True
Else
.Fields("Password_Protection_Enabled").Value = False
End If
If chkTattleTale.Checked = True Then
.Fields("TattleTale_Enabled").Value = True
Else
.Fields("TattleTale_Enabled").Value = False
End If
.Fields("User_Password").Value = txtPassword.Text
.Fields("Security_Question").Value = cmbQuestion.Text
.Fields("Security_Answer").Value = txtAnswer.Text
.Fields("Email_Address").Value = txtEmail.Text
.Fields("Mobile_Phone_Number").Value = txtMobile.Text
.Fields("Mobile_Service_Provider").Value = cmbServiceProvider.Text
.Fields("Mobile_SMS_Server").Value = txtSMSServer.Text
.Fields("Mobile_MMS_Server").Value = txtMMSServer.Text
If chkEmail.Checked = True Then
.Fields("Email_Enabled").Value = True
Else
.Fields("Email_Enabled").Value = False
End If
If chkSMS.Checked = True Then
.Fields("SMS_Enabled").Value = True
Else
.Fields("SMS_Enabled").Value = False
End If
If chkMMS.Checked = True Then
.Fields("MMS_Enabled").Value = True
Else
.Fields("MMS_Enabled").Value = False
End If
If Not (PicPath = "") Then
.Fields("Default_Wallpaper").Value = PicPath
Else
.Fields("Default_Wallpaper").Value = ""
End If
.Fields("Document_Background_Color").Value = picDocumentBackground.BackColor
.Fields("Document_Font_Color").Value = picDocumentFontColor.BackColor
.Fields("Default_Font").Value = cmbFont.Text
.Fields("Default_Font_Size").Value = cmbFontSize.Text
.Fields("Document_Left_Margin").Value = txtLeftMargin.Text
.Fields("Document_Right_Margin").Value = txtRightMargin.Text
If chkDefault.Checked = True Then
.Fields("Is_Default_Profile").Value = True
SetAsDefault()
Else
.Fields("Is_Default_Profile").Value = False
End If
.Fields("Toolbar_Visible").Value = True
.Fields("Options_Toolbar_Visible").Value = True
.Fields("Status_Bar_Visible").Value = True
.Fields("Timestamp_Entries").Value = False
.Fields("Is_Locked").Value = False
.Update()

End With
rec.Close()
cmd = Nothing
rec = Nothing
con.Close()
con = Nothing
End If
Catch ex As Exception
MsgBox(ex.ToString())
End Try


End Sub

View the full article
 
Back
Top