I am this close (pinching fingers close together) to getting the sledgehammer

[ejy]

AARRRRRRRRGGGGGGGGGGGGGGHHHHH!!!!!!!!!!!

That feels better. Now, the problem:

I have the following code on my computer at home, using the Working Model edition...


Dim SQL As String
Dim Db As Database
Dim Rs As Recordset

in command button -
Set Db = OpenDatabase("c:\myfolder\myDb.mdb")
SQL = "SELECT * FROM yourtable WHERE zipcode = '40202' "
Set Rs = Db.OpenRecordset(SQL, dbOpenDynaset)


This code works dandy. In order to "make" the program, I must go to the local university's computer lab (Working Model doesn't have this feature.) So I put the program on disk, trot down to the computer lab, run the program and voila...the following error appears: "User defined data type not defined." The 'Dim Db as Database' line is highlighted.

Now then, I do not have to explicitly declare a data type at home, when I am using the Working Model. I just put the aforementioned 'Dim' statements in the general declarations, and everything works. What's the dilly? What is going on? Mayhem is about to ensue!!!!!

[plenderj]

Project > References > Microsoft DAO x.xx Object Library

[chrisa_uk]

is the university computer referencing the database component...and the same version....Uni compouter may not have the same reference as your machine

[ejy]

Plenderj.....please elaborate

Chrisa....i don't understand what you mean by 'referencing the database component'

[plenderj]

You need to reference the database components of windows before you can start using database stuff. So to do that, you go into project > references > dao ....

You'll have to do that on the uni computer

[Cander]

Project > References > Microsoft DAO x.xx Object Library


You have to have a reference to the DAO object

follow the above as plenderj showed on you Visual Basic editor menu.

[ejy]

Thanks! I'll give it a shot and let you know what happens.

[ejy]

It worked!!!! I will name one of my children "PlenderChrisaCander"

[gab2001uk]

Alterative method. Use late binding so you do not need to add any references

Dim dbE As Object
    Dim db As Object
 
    Set dbE = CreateObject("DAO.DBEngine.36")
    Set db = dbE.OpenDatabase("PathAndFileDatabase,mdb")

[WorkHorse]

Will that slow stuff down, gab?

[Joacim Andersson]

Originally posted by WorkHorse
Will that slow stuff down, gab?

Yes it will, extremly much actually.
Using late bounding is like using Variants for every variable you use.

[gab2001uk]

I have not tested the speed issue in the real world, but if you use your db variables at form or module level, then once declared and created, the speed should be the same.
One disadvantage is you lose the intellisense, so the list of available properties / methods does not pop up after you type say Set db.
It would have helped the original poster, in the situation of using somebody else's computer.

[Joacim Andersson]

No, using a generic Object type is much slower then declaring the object as the type you want to use, in this case as Database and Recordset.

[gab2001uk]

Just to find out the difference I ran some code to copy the Northwind 2000 database object by object, using a reference to DAO v 3.6 and with the CreateObject method.
The code shown below was run, then the variables changed to Dim dbSrc As DAO.XXX etc.. This gave the following results in milliseconds (ADOX code shown for interest):

Method         1st Run    2nd Run   3rd run
CreateObject   2377       2172      2184
Reference      1256       1167      1163 
ADOX           7266       6745      6696

So it seems direct reference is almost twice the speed of Create Object,(and about six times faster than ADOX)

Private Sub cmdDAOCopy_Click()
    Dim dbE As Object
    Dim dbSrc As Object
    Dim dbNew As Object
    Dim tdefSrc As Object
    Dim tdefNew As Object
    Dim fdSrc As Object
    Dim fdNew As Object
    Dim ixSrc As Object
    Dim ixNew As Object
    Dim rsSrc As Object
    Dim rsNew As Object
    Dim rlSrc As Object
    Dim rlNew As Object
    Dim qdSrc As Object
    Dim qdNew As Object
    Dim prop As Object
    
    Dim fAccess97 As Boolean
    Dim strSource As String
    Dim strDestination As String
    Dim strPassword As String
    Dim iCt As Integer
    Dim iCount As Integer
    Dim cTimer As clsTimer
    Dim tl As Long
    Dim t1 As Long, t2 As Long
    
    'select database to copy
    With cdlgFile
        .DialogTitle = "Select Database to Copy"
        .Filter = "Access 97/2000 (*.mdb)|*.mdb"
        .CancelError = False
        .InitDir = "C:\My Documents"
        .ShowOpen
    End With
    strSource = cdlgFile.FileName
    If strSource = "" Then
        MsgBox "Cancel clicked"
        Exit Sub
    End If
    
    strPassword = InputBox("Enter password for this database. Leave blank if no password required")
    
    'open database with DAO 3.6 then find correct version
    Set dbE = CreateObject("DAO.DBEngine.36")
    Set dbSrc = dbE.OpenDatabase(strSource, False, False, ";pwd=" & strPassword)
    
    On Error Resume Next
    'loop through properties to find "Connect"
    For Each prop In dbSrc.Properties
        If prop.Name = "Version" Then
            If prop.Value = "3.0" Then
                fAccess97 = True
            Else
                fAccess97 = False
            End If
            Exit For
        End If
    Next prop
    On Error GoTo 0
    
    If fAccess97 Then
        'Check if copy is to stay as Access 97 or convert to 2000
        If MsgBox(strSource & vbCrLf & "Is an Access 97 Database. Do you want to convert it to Access 2000 Format?", vbQuestion + vbYesNo) = vbYes Then
            fAccess97 = False
        End If
    End If
    'Select name of database copy
    With cdlgFile
        .DialogTitle = "Save Database as"
        .Filter = "Access 97/2000 (*.mdb)|*.mdb"
        .CancelError = True
        .InitDir = "C:\My Documents"
        .ShowSave
    End With
    strDestination = cdlgFile.FileName
    
    'check if chosen name already exists
    If Dir$(strDestination) <> "" Then
        If MsgBox(strDestination & " already exists. Overwrite?", vbQuestion + vbYesNo) = vbNo Then
            Exit Sub
        Else
            Kill strDestination
        End If
    End If
    
    'start timing...
    Set cTimer = New clsTimer
    cTimer.Reset
    
    Me.Caption = "Creating database..."
    DoEvents
    
    If fAccess97 Then
        'create 97 version
        Set dbNew = dbE.CreateDatabase(strDestination, dbLangGeneral, dbVersion30)
    Else
        'create 2000 version
        Set dbNew = dbE.CreateDatabase(strDestination, dbLangGeneral, dbVersion40)
    End If
    
    'now copy tables
    For Each tdefSrc In dbSrc.TableDefs
        'check if system table
        If InStr(1, tdefSrc.Name, "MSys", vbTextCompare) = 0 Then
            'not a system table
            Set tdefNew = dbNew.CreateTableDef(tdefSrc.Name)
            tdefNew.ValidationRule = tdefSrc.ValidationRule
            tdefNew.ValidationText = tdefSrc.ValidationText
            For Each fdSrc In tdefSrc.Fields
                'check for replication fields s_GUID, s_Generation, s_Lineage, Gen_XXX
                If InStr(1, fdSrc.Name, "s_", vbTextCompare) = 0 And InStr(1, fdSrc.Name, "Gen_", vbTextCompare) = 0 Then
                    Set fdNew = tdefNew.CreateField(fdSrc.Name, fdSrc.Type, fdSrc.Size)
                    On Error Resume Next
                    fdNew.Attributes = fdSrc.Attributes
                    fdNew.AllowZeroLength = fdSrc.AllowZeroLength
                    fdNew.DefaultValue = fdSrc.DefaultValue
                    fdNew.Required = fdSrc.Required
                    fdNew.Size = fdSrc.Size
                    tdefNew.Fields.Append fdNew
                    On Error GoTo 0
                End If
            Next
            'now copy indexes
            For Each ixSrc In tdefSrc.Indexes
                'Check for replication indices s_GUID, s_Generation
                If InStr(1, ixSrc.Name, "s_", vbTextCompare) = 0 Then
                    'Don't copy indices set as part of Relation Objects
                    If Not ixSrc.Foreign Then
                        Set ixNew = tdefNew.CreateIndex(ixSrc.Name)
                        ixNew.Clustered = ixSrc.Clustered
                        ixNew.IgnoreNulls = ixSrc.IgnoreNulls
                        ixNew.Primary = ixSrc.Primary
                        ixNew.Required = ixSrc.Required
                        ixNew.Unique = ixSrc.Unique
                        'Add Index field(s)
                        For Each fdSrc In ixSrc.Fields
                            Set fdNew = ixNew.CreateField(fdSrc.Name)
                            fdNew.Attributes = fdSrc.Attributes
                            ixNew.Fields.Append fdNew
                        Next
                        tdefNew.Indexes.Append ixNew
                    End If
                End If
            Next
            dbNew.TableDefs.Append tdefNew
        End If
    Next
    
    'now copy querydefs
    For Each qdSrc In dbSrc.QueryDefs
        Set qdNew = dbNew.CreateQueryDef(qdSrc.Name, qdSrc.SQL)
        qdNew.Connect = qdSrc.Connect
        qdNew.MaxRecords = qdSrc.MaxRecords
        qdNew.ReturnsRecords = qdSrc.ReturnsRecords
        'Next Line gives error 3219 Invalid operation, but is not needed as added automatically!
        'Nice to have such consistency when dealing with objects!
        'dbSrc.QueryDefs.Append qdNew
    Next qdSrc
    
    'now copy data
    Me.Caption = "Copying Data..."
    DoEvents
    For Each tdefSrc In dbSrc.TableDefs
        If InStr(1, tdefSrc.Name, "MSys", vbTextCompare) = 0 Then
            'not a system table
            Set rsNew = dbNew.OpenRecordset(tdefSrc.Name, dbOpenTable)
            Set rsSrc = dbSrc.OpenRecordset(tdefSrc.Name, dbOpenTable)
            
            If Not rsSrc.BOF Then
                rsSrc.MoveFirst
                Do Until rsSrc.EOF
                    rsNew.AddNew
                    For iCt = 0 To rsNew.Fields.Count - 1
                        rsNew.Fields(iCt).Value = rsSrc.Fields(rsNew.Fields(iCt).Name).Value
                    Next
                    rsNew.Update
                    rsSrc.MoveNext
                Loop
            End If
            rsNew.Close
            rsSrc.Close
        End If
    Next
    
    'now copy relations
    'Does not seem to be a similar method available with ADO...
    For Each rlSrc In dbSrc.Relations
        Set rlNew = dbNew.CreateRelation(rlSrc.Name, rlSrc.Table, rlSrc.ForeignTable, rlSrc.Attributes)
        For Each fdSrc In rlSrc.Fields
            rlNew.Fields.Append rlNew.CreateField(fdSrc.Name)
            rlNew.Fields(fdSrc.Name).ForeignName = rlSrc.Fields(fdSrc.Name).ForeignName
        Next fdSrc
        dbNew.Relations.Append rlNew
    Next rlSrc
    dbNew.Close
    dbSrc.Close
    Set dbE = Nothing
    tl = cTimer.Interval
    Me.Caption = "Time taken " & tl & " ms(" & tl / 1000 & " secs, " & (tl / 1000) / 60 & " mins"
    Set cTimer = Nothing
End Sub

Code for clsTimer

Option Explicit
 
Private Declare Function timeGetTime Lib "winmm.dll" () As Long
Private StartTime As Long
Private Sub Class_Initialize()
    StartTime = timeGetTime()
End Sub
Public Property Get Interval() As Long
   'return time interval in milliseconds
   Interval = timeGetTime() - StartTime
End Property
Public Sub Reset()
   ' Reset starting time.
    StartTime = timeGetTime()
End Sub