VBA code not working after splitting DB

Manos39

Registered User.
Local time
Today, 08:38
Joined
Feb 14, 2011
Messages
248
Hello, i have very little knowledge of vba, still there should be a solution
my DB was working everything good modules etc
After splitting front end command which calls this module
Code:
Public Function fncNextShift(ByVal dte2 As Variant, ByVal teamID As Long) As String
Static rs As DAO.Recordset
Dim i As Date, j As Long
Dim d1 As Date, d2 As Date
Dim cnt As Long, incr As Integer
If (rs Is Nothing) Then
    Set rs = CurrentDb.OpenRecordset("InitScheduletbl", dbOpenTable)
    rs.Index = "teamID"
End If
incr = 1
With rs
    .MoveFirst
    d1 = rs("DateParam")
    If IsDate(dte2) = False Or dte2 = d1 Then
    Else
        d2 = dte2
        If d1 > dte2 Then
            incr = -1
        End If
        For i = d1 + incr To d2 Step incr
            'If InStr("/sat/sun/", Format$(i, "/ddd/")) <> 0 Then
            'Else
                teamID = teamID + incr
                If teamID > 5 Then
                    teamID = 1
                Else
                    If teamID < 1 Then
                        teamID = 5
                    End If
                End If
            'End If
        Next
        
    End If
    .Seek "=", teamID
    fncNextShift = rs("shift")
End With
End Function

Does not work error 3219 (invalid operation)
opening vba editor there is highlighted:
Set rs = CurrentDb.OpenRecordset("InitScheduletbl", dbOpenTable)

what is wrong?
 
dbOpenTable and Seek ... are only applicable to real tables, not linked tables.
You either have to reprogram something, or you set the DB reference to the backend for this measure.
 
dbOpenTable and Seek ... are only applicable to real tables, not linked tables.
You either have to reprogram something, or you set the DB reference to the backend for this measure.
How do i do that (to the backend)
 
Code:
Dim dbEx As DAO.Database
Set dbEx = OpenDatabase("X:\Anywhere\YourBE.accdb")
Set rs = dbEx.Openrecordset("InitScheduletbl", dbOpenTable)

Or in the first case something like
Code:
Set rs = CurrentDb.OpenRecordset("SELECT shift FROM InitScheduletbl WHERE teamID = X", dbOpenSnapshot)
(filter specifically instead of searching in a loop)
 
Last edited:
you copy this in a Module:
Code:
Public Function OpenTableFromLinkedTable(ByVal sLinkTableName As String) As DAO.Recordset
    Dim sdb As String, src As String
    Dim db As DAO.Database
    Set db = CurrentDb
    With db.TableDefs(sLinkTableName)
        sdb = .Connect
        src = .SourceTableName
        sdb = Replace$(sdb, ";DATABASE=", "")
    End With
    Set db = OpenDatabase(sdb, False, False)
    Set OpenTableFromLinkedTable = db.OpenRecordset(src, dbOpenTable)
    Set db = Nothing
End Function

now change the Part of your code to this:
Code:
...
...
...
If (rs Is Nothing) Then
    'Set rs = CurrentDb.OpenRecordset("InitScheduletbl", dbOpenTable)
    Set rs = OpenTableFromLinkedTable("InitScheduletbl")
    rs.Index = "teamID"
End If
...
...
...
 
Statically declared recordset, use of Seek as a known very fast method - one can assume that value is placed on performance. Continuing with such thoughts, I would think of persistent references to the databases instead of determining and creating them from scratch.
However, something like this as a concrete code is embedded in a known overall task.
 
you copy this in a Module:
Code:
Public Function OpenTableFromLinkedTable(ByVal sLinkTableName As String) As DAO.Recordset
    Dim sdb As String, src As String
    Dim db As DAO.Database
    Set db = CurrentDb
    With db.TableDefs(sLinkTableName)
        sdb = .Connect
        src = .SourceTableName
        sdb = Replace$(sdb, ";DATABASE=", "")
    End With
    Set db = OpenDatabase(sdb, False, False)
    Set OpenTableFromLinkedTable = db.OpenRecordset(src, dbOpenTable)
    Set db = Nothing
End Function

now change the Part of your code to this:
Code:
...
...
...
If (rs Is Nothing) Then
    'Set rs = CurrentDb.OpenRecordset("InitScheduletbl", dbOpenTable)
    Set rs = OpenTableFromLinkedTable("InitScheduletbl")
    rs.Index = "teamID"
End If
...
...
...
Arnel i tryed as you said still nothing appeared ( a report in the case)
but, maybe it does but expected action needed after that -(opening a report)- is depended by this module
Code:
Public Sub ReportQPlanSource(ByRef col As Collection)
Dim sql As String, fld_name As String, i As Integer
Dim p As Parameter
'sql = "SELECT Epitheto,[A/A],"
' get all the headers of the query
With CurrentDb.QueryDefs("QrPlanCross")
    For Each p In .Parameters
        p = Eval(p.Name)
    Next
    With .OpenRecordset
    With .OpenTableFromLinkedTable
        ' get the headers that have value
        For i = 0 To .Fields.Count - 1
            fld_name = .Fields(i).Name
            If i < 3 Then
                col.Add fld_name
            Else
            'If fld_name <> "Epitheto" And fld_name <> "A/A" Then
                If Val(DCount("[" & fld_name & "]", "QrPlanCross") & "") <> 0 Then
                    'sql = sql & "[" & fld_name & "],"
                    col.Add fld_name
                End If
            End If
        Next
        .Close
    End With
End With
'the first sql
'If Len(sql) > 22 Then
'    sql = Left$(sql, Len(sql) - 1) & " FROM QrPlanCross;"
'Else
'    sql = "SELECT * FROM QrPlanCross"
'End If
'Debug.Print sql
End Sub

which needs to be modifiyed maybe?
 
Last edited:
you remove the function in the above code (sub ReportQPlanSource).
you only Need it on function fncNextShift, since you are using Index
on the Linked table (see 2nd code on post #5).
 
you remove the function in the above code (sub ReportQPlanSource).
you only Need it on function fncNextShift, since you are using Index
on the Linked table (see 2nd code on post #5).
Arnel i did try all day, maybe if you saw my sample posted below you would figure out what is wrong
To run one should change to system locale Greek in windows
and from ypovolesfrm hit button planA3 or plan A4 after selecting year (has records for current year), month (all months) and a team.
Please?
 
Last edited:
i only change your module name, (you can't have The Same function/Sub and Module name).
i only modify fnnextshift.
i can't test your db, i only have english (one language) office.

make sure to use Linked tables.
 

Attachments

i only change your module name, (you can't have The Same function/Sub and Module name).
i only modify fnnextshift.
i can't test your db, i only have english (one language) office.

make sure to use Linked tables.
I
i only change your module name, (you can't have The Same function/Sub and Module name).
i only modify fnnextshift.
i can't test your db, i only have english (one language) office.

make sure to use Linked tables.
Arnel it is working perfectly!! Thank you so much!!
 

Users who are viewing this thread

Back
Top Bottom