Storing data, in mdb?

[tonydotigr]

Hi all,

I am new to programming w/ Visual Basic and have a few probably noob questions. I am creating a program that will store restaurant names in a file. Then later randomly pick one. What would be my best be for storing this data? I would prefer storing the data in a mdb then access it with queries and DAO, because I am familiar with this. The only thing that worries me is, what if my users don’t have access installed, will this affect them? I also heard of using the ‘Scripting Runtime’ File system objects.

Thanks in Advance

[leinad31]

Store it in a database and use SQL + ADO.

I can't see why you'll need to use the file system object since your accessing just one file; the database.

[si_the_geek]

The only thing that worries me is, what if my users don’t have access installed, will this affect them?

Nope, they do not need Access - but they may need the drivers (see the MDAC link below, and find "Jet" drivers).

I would also recommend using ADO rather than DAO tho, as I think that DAO is no longer supported. There isn't much difference in the code needed, see the "ADO Tutorial" link below for an example.

[tonydotigr]

Thanks for the help!!!

[rory]

This may have nothing to do with the question but thought I would share
this anyway ...

Example Creating an Access Database (2 tables in the example) and also encrypting the password ..

(an error will close the program by default)
Change /db/ to your database folder path ..

Public Const strDbName As String = "myDB.mdb"                             
Public Const strDbPass As String = "EIFHTNGHJTHTKEDKDIRJR"                       
Public Const strDbError As String = "Error Creating Database!"
Public Const strDbErrorExit As String = "Program Will Exit Now"

Public Sub Database_Create()

On Error GoTo err_create_db:
    Dim cat As ADOX.Catalog
    Dim tblNew As ADOX.Table
    Dim tblNew2 As ADOX.Table
    Dim idx As ADOX.index
    Dim idx2 As ADOX.index
        
        Set cat = New ADOX.Catalog
        cat.Create "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\db\" & strDbName & ";Jet OLEDB:Database Password=" & cmdEnc(strDbPass) & "; Jet OLEDB:Encrypt Database=True;"
        
        Set tblNew = New ADOX.Table
        
            With tblNew
                .name = "table1"
                .ParentCatalog = cat
                .Columns.Append "id", adInteger
                .Columns("id").Properties("Autoincrement") = True
                .Columns("id").Properties("Increment") = CLng(1)
                .Columns("id").Properties("Seed") = CLng(1)
                .Columns.Append "strField1", adVarWChar, 255
                .Columns.Append "strField2", adVarWChar, 255
                .Columns.Append "intField3", adInteger
                .Columns.Append "intField4", adInteger
            End With
            
        cat.Tables.Append tblNew
        Set idx = New ADOX.index
        
            With idx
                .name = "PrimaryKey"
                .Columns.Append "id"
                .PrimaryKey = True
                .Unique = True
            End With
            
        tblNew.Indexes.Append idx
        Set idx = Nothing
        Set tblNew2 = New ADOX.Table
        
            With tblNew2
                .name = "table2"
                .ParentCatalog = cat
                .Columns.Append "id", adInteger
                .Columns("id").Properties("Autoincrement") = True
                .Columns("id").Properties("Increment") = CLng(1)
                .Columns("id").Properties("Seed") = CLng(1)
                .Columns.Append "strField1", adVarWChar, 255
                .Columns.Append "intField2", adInteger
            End With
            
        cat.Tables.Append tblNew2
        Set idx2 = New ADOX.index
            
            With idx2
                .name = "PrimaryKey"
                .Columns.Append "id"
                .PrimaryKey = True
                .Unique = True
            End With
            
        tblNew2.Indexes.Append idx2
        Set idx2 = Nothing
        
        Set cat = Nothing
        Exit Sub
        
close_db:
    On Error Resume Next
    Set idx = Nothing
    Set idx2 = Nothing
    Set cat = Nothing
    End

err_create_db:
    MsgBox strDbError & vbCrLf & strDbErrorExit, vbCritical, strProgName
    GoTo close_db:
End Sub

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' PUBLIC FUNCTION: DECRYPT STRING
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Function cmdDec(ByVal strDec As String) As String
    Dim sinp, sout, sc, nc, p
        sinp = strDec
        sout = ""
    
        For p = 1 To Len(sinp) Step 1
            sc = Mid(sinp, p, 1)
            nc = Asc(sc) - 3
            sout = sout + Chr(nc)
        Next p
    
        cmdDec = sout
End Function

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' PUBLIC FUNCTION: ENCRYPT STRING
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Function cmdEnc(ByVal strEnc As String) As String
    Dim sinp, sout, sc, nc, p
        sinp = strEnc
        sout = ""
    
        For p = 1 To Len(sinp) Step 1
            sc = Mid(sinp, p, 1)
            nc = Asc(sc) + 3
            sout = sout + Chr(nc)
        Next p
    
        cmdEnc = sout
End Function

And here is a way to lock the access database so it is less easy to open ..
This locks it when it is closed, and unlocks it when it is open ...
Any questions let me know .. works well for me ..

Note. If you change the Database name to .dll or similar (instead of .mdb), it will still work, and is less easy to be opened be anyone else but the program ..

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' PUBLIC SUB ROUTINE: LOCK DATABASE 
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Sub Database_Lock()

    Lock_Database App.Path & "\db\" & strDbName, 1

End Sub
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' PUBLIC SUB ROUTINE: UNLOCK DATABASE
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Sub Database_UnLock()
    
    Lock_Database App.Path & "\db\" & strDbName, 2

End Sub
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' PUBLIC FUNCTION: DOES FILE EXIST
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Function Does_File_Exist(ByVal Filename As String)

On Error Resume Next
    Dim fso
    
    Set fso = CreateObject("Scripting.FileSystemObject")
        If (fso.FileExists(Filename)) Then
            Does_File_Exist = "true"
        End If
    Set fso = Nothing
    
End Function
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' PUBLIC SUB ROUTINE: LOCK DATABASE PROCESS
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Sub Lock_Database(sPath As String, iAction As LockDatabase)

    If Does_File_Exist(App.Path & "\db\" & strDbName) = "true" Then
    
    Dim iFreeFile   As Integer
    Dim iLoop       As Long
    Dim lLoc        As Long
    Dim sString
    Dim lLoop
    
        hGet = ""
        iFreeFile = FreeFile()
        Open sPath For Binary As #iFreeFile
        lLoc = 1
        Select Case iAction
            Case 1
                sString = cmdEnc(strEncrKey)
                For lLoop = 5 To 19
                    Put #iFreeFile, lLoop, Mid$(sString, lLoop - 4, 1)
                Next lLoop
            Case 2
                sString = cmdEnc(strEncrKey)
                For lLoop = 5 To 19
                    hGet = hGet & Mid$(sString, lLoop - 4, 1)
                Next lLoop
                lLoc = 1
            
                If cmdDec(hGet) = strEncrKey Then
                    sString = "Standard Jet DB"
                    For lLoop = 5 To 19
                        Put #iFreeFile, lLoop, Mid$(sString, lLoop - 4, 1)
                    Next lLoop
                End If
        End Select
        Close #iFreeFile
        End If
        
End Sub

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' PUBLIC SUB ROUTINE: OPEN DATABASE CONNECTION 
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Sub Open_Database_Connection()

On Error Resume Next

   Database_UnLock
    Set ado = CreateObject("ADODB.Connection")
    ado.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\db\" & strDbName & ";Jet OLEDB:Database Password=" & cmdEnc(strDbPass) & ";"

End Sub

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' PUBLIC SUB ROUTINE: CLOSE DATABASE CONNECTION 
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Sub Close_Database_Connection()

On Error Resume Next
    ado.Close
    Set ado = Nothing
    Database_Lock
    
End Sub

And to check if the database exists and create it if it doesnt exist ..
use this like on Form Load ..

If Does_File_Exist(App.Path & "\db\" & strDbName ) <> "true" Then Database_Create

PS. i realise the database code could have some more error checking but for this example thought i would leave as is ..