Results 1 to 4 of 4

Thread: Accessing MS Access 2003 from VB6

  1. #1

    Thread Starter
    Fanatic Member AccessShell's Avatar
    Join Date
    Oct 2013
    Posts
    790

    Accessing MS Access 2003 from VB6

    It has been a long time since I wrote any code so please excuse the naming conventions and the novice coding.
    In VB6 I have successfully opened an MS Access 2003 database with the following code
    Public Sub OpenDatabase()
    Dim Msg As String

    DbOpened = True
    MyFile = App.Path & "\PrintDir.MDB" ' Define name of database.
    On Error GoTo OpenDatabase_eh
    Set MyWorkspace = Workspaces(0)

    ' Open database.
    Set MyDatabase = MyWorkspace.OpenDatabase(MyFile)
    Exit Sub
    Later on I successfully update the database with the following code
    Public Function UpdateDatabase(strFileName As String)
    Dim intErrNbr As Integer
    Dim Msg As String
    Dim strErr As String
    Dim a As Integer
    On Error GoTo UpdateDatabase_eh

    If strFileName = "" Then
    Exit Function
    End If
    BeginTrans
    Set MyTable = MyDatabase.OpenRecordset("FileInfo", dbOpenDynaset)

    MyTable.AddNew
    MyTable![FileName] = strFileName
    .
    .
    .
    MyTable.Update

    gstrFileName = ""
    glngFileSize = 0
    gvarFileDateCreated = ""
    gstrFileComments = ""

    CommitTrans
    MyTable.Close

    Exit Function

    UpdateDatabase_eh:

    intErrNbr = Err
    strErr = Error
    Msg = "Err = " & intErrNbr & ", Error = " & strErr & vbCrLf & vbCrLf
    Msg = Msg & " " & gstrFileName
    MsgBox Msg, vbCritical
    Rollback
    On Error GoTo 0

    End Function
    However, when I try to delete the table entries, not the table, before I update the table I get error 2075, "The operation requires an open database".
    Private Function DeleteTableContents()
    Dim strMsg As String
    Dim intAns As Integer
    Dim DSQL As String
    Dim intDCount As Integer
    Dim xclSQL As String

    On Error GoTo DeleteTableContents_eh
    Set MyTable = MyDatabase.OpenRecordset("FileInfo", dbOpenDynaset)
    DSQL = "DELETE * FileInfo.FileName FROM FileInfo "
    DSQL = DSQL & "WHERE Not FileInfo.FileName = Xtest.jpg" '& "isnull"
    'doCmd.SetWarnings False
    DoCmd.RunSQL DSQL
    'doCmd.SetWarnings True
    MyTable.Close
    Exit_DeleteTableContents:
    Exit Function
    DeleteTableContents_eh:
    MsgBox "DeleteTableContents - Error Number = " & Err.Number & ", Error Description = " & Err.Description
    Resume Exit_DeleteTableContents

    End Function


    Can anyone see what I am missing?
    Thanks

  2. #2
    Hyperactive Member
    Join Date
    Nov 2011
    Posts
    498

    Re: Accessing MS Access 2003 from VB6

    Here is the code i use to connect VB6 to MS Access2003 DB backend using ADO

    'place in module

    Public dbfileAdd As String
    Global conndb As ADODB.Connection
    Global rsVar As ADODB.Recordset
    Global ISDBOPEN As Boolean

    Public Sub OpenDB(byval dbfile as string )

    If dbfile <> "" Then

    If FileExists(dbfile) = True Then ' Fileexists is just a function to check db exists.Not included!


    ' Establish the Connection
    Set conndb = New ADODB.Connection
    conndb.CursorLocation = adUseClient
    conndb.ConnectionString = _
    "Provider=Microsoft.Jet.OLEDB.4.0;" & _
    "Data Source=" & dbfile & ";" & _
    "Persist Security Info=False"
    ' conndb.Properties("Jet OLEDBatabase Password") = "xxxx" 'uncomment if password protected

    ' Open the Connection
    conndb.Open


    ISDBOPEN = True

    Else


    ISDBOPEN = False
    Call MsgBox("The Path is not valid." , vbOKOnly + vbExclamation + vbApplicationModal + vbDefaultButton1, "Error")

    End If
    Else

    ISDBOPEN = False

    End If


    End Sub


    Public Sub CloseDB()
    If ISDBOPEN = True Then
    conndb.Close
    Set conndb = Nothing
    End If
    End Sub


    'In Form Load place
    Private Sub Form_Load()

    OpenDB "path to DB" ' this will open DB while app is running

    if ISDBOPEN = True then
    ' process some DB stuff
    else

    'DB Not Open, run some more code to check db exists


    end if

    'In Form Form_QueryUnload
    Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)

    Call CloseDB ' this will close DB when closing app

    End Sub




    End Sub

    'in form button click etc to list info
    Private Sub cmdAction_Click()

    Dim strSQL As String,strTitle as string ,strNextInfo as string

    ' SQL Query goes here................

    strSQL = "SELECT Data.[Title],Data.[NextInfo]"
    strSQL = strSQL & " FROM Data"
    strSQL = strSQL & " WHERE (((Data.[Title])='" & Replace(Title, "'", "''") & "'));" ' <<< convert single ' to double '' as if single ' in string will cause problems

    Set rsVar = New ADODB.Recordset
    rsVar.Open strSQL, conndb, adOpenStatic, adLockOptimistic, adCmdText

    If rsVar.BOF = True And rsVar.EOF = True Then ' search found nothing

    Else

    'data.title
    If IsNull(rsVar.Fields(0).Value) Then

    Else
    If rsVar.Fields(0).Value = "" Then

    Else

    strTitle = rsVar.Fields(0).Value
    End If

    End If

    'data.NextInfo
    If IsNull(rsVar.Fields(1).Value) Then

    Else
    If rsVar.Fields(1).Value = "" Then

    Else

    strNextInfo= rsVar.Fields(1).Value
    End If

    End If

    End If

    rsVar.Close
    Set rsVar = Nothing

    msgbox strTitle & " " & strNextInfo ' <<< do what ever with output ie place in textbox or a Flexigrid to display data

    end sub


    ''To delete a record

    Private Sub cmdDelete_Click()

    SQLDelete = "DELETE * from Data where RecordNo =" & Val(RecID) ' << could be RecID or Title etc
    conndb.Execute (SQLDelete)

    End Sub
    Last edited by k_zeon; Feb 18th, 2014 at 03:26 PM. Reason: spelling mistake

  3. #3

    Thread Starter
    Fanatic Member AccessShell's Avatar
    Join Date
    Oct 2013
    Posts
    790

    Re: Accessing MS Access 2003 from VB6

    Thanks. I will evaluate.

  4. #4
    Hyperactive Member
    Join Date
    Nov 2011
    Posts
    498

    Re: Accessing MS Access 2003 from VB6

    Quote Originally Posted by AccessShell View Post
    Thanks. I will evaluate.
    if you need the update part as well , let me know

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  



Click Here to Expand Forum to Full Width