DMAX in VBA (Excel 2007)

[cstimart]

I am trying to utilize the following example of ADO to resent the AutoNumber in the associated Access db.

http://allenbrowne.com/func-ADOX.html#GetSeedADOX

However, I get a complile error that indicates that DMax is not defined. Is this not applicable in Office 2007? or am I missing a reference?

 

[jkpieterse]

DMAX is an Access VBA function not known to Excel VBA. If you put a reference to the Access object library and have your code instantiate an instance of Access, then you can make it work.

 

[cstimart]

I added the reference and now I'm getting Run-time error '2950 "Reserved Error.

 

[jkpieterse]

I guess you better post your code.

 

[cstimart]

Here you go...I am trying to reset when I clear the data after it's been used.

Private Sub Erase_Data()
'Connect to access
    Set cnn = New ADODB.Connection
    MyConn = "M:\REPORT" & Application.PathSeparator & TARGET_DB
    With cnn
            .Provider = "Microsoft.Jet.OLEDB.4.0"
            .Open MyConn
    End With
'Clear Data from Access
    For i = 1 To 5
            strSql = "DELETE FROM [" & tblName(i) & "]"
            cnn.Execute strSql
    Call ResetSeed(tblName(i))
    Next i
    cnn.Close
    Set cnn = Nothing
End Sub

AND

Private Function ResetSeed(strTable As String) As String
    Dim strAutoNum As String
    Dim lngSeed As Long
    Dim lngNext As Long
    Dim strSql As String
    Dim strResult As String
 
    lngSeed = GetSeedADOX(strTable, strAutoNum)
    If strAutoNum = vbNullString Then
        strResult = "AutoNumber not found."
    Else
        lngNext = Nz(DMax(strAutoNum, strTable), 0) + 1
        If lngSeed = lngNext Then
            strResult = strAutoNum & " already correctly set to " & lngSeed & "."
        Else
            Debug.Print lngNext, lngSeed
            strSql = "ALTER TABLE [" & strTable & "] ALTER COLUMN [" & strAutoNum & "] COUNTER(" & lngNext & ", 1);"
            Debug.Print strSql
            CurrentProject.Connection.Execute strSql
            strResult = strAutoNum & " reset from " & lngSeed & " to " & lngNext
        End If
    End If
    MsgBox strResult
End Function

AND

Private Function GetSeedADOX(strTable As String, Optional ByRef strCol As String) As Long
    Dim cat As New ADOX.Catalog
    Dim tbl As New ADOX.Table
    Dim col As New ADOX.Column
 
    Set cat.ActiveConnection = cnn
    Set tbl = cat.Tables(strTable)
 
    For Each col In tbl.Columns
        If col.Properties("Autoincrement") Then
            strCol = "[" & col.Name & "]"
            GetSeedADOX = col.Properties("Seed")
            Exit For
        End If
    Next
 
    Set col = Nothing
    Set tbl = Nothing
    Set cat = Nothing
End Function

 

[jkpieterse]

I think like this:

Private Function ResetSeed(strTable As String) As String
    Dim strAutoNum As String
    Dim lngSeed As Long
    Dim lngNext As Long
    Dim strSql As String
    Dim strResult As String
    Dim oAccess as Object
    Set oAccess = CreateObject("Access.Application")
    lngSeed = GetSeedADOX(strTable, strAutoNum)
    If strAutoNum = vbNullString Then
        strResult = "AutoNumber not found."
    Else
        lngNext = Nz(oAccess.DMax(strAutoNum, strTable), 0) + 1
        If lngSeed = lngNext Then
            strResult = strAutoNum & " already correctly set to " & lngSeed & "."
        Else
            Debug.Print lngNext, lngSeed
            strSql = "ALTER TABLE [" & strTable & "] ALTER COLUMN [" & strAutoNum & "] COUNTER(" & lngNext & ", 1);"
            Debug.Print strSql
            CurrentProject.Connection.Execute strSql
            strResult = strAutoNum & " reset from " & lngSeed & " to " & lngNext
        End If
    End If
    MsgBox strResult
oAccess.Quit
Set oAccess=Nothing
End Function

 

[cstimart]

I got the "Reserved Error" on this line.

lngNext = Nz(oAccess.DMax(strAutoNum, strTable), 0) + 1

 

[jkpieterse]

Hmmm. Looks like I'm over my head here.
Someone else perhaps???

 

[cstimart]

From searching with the Google Machine, it sounds like it might be a Registry issue...and I'm not wanting to mess with the work computer.