Solved accdb v accde

[John Sh]

when I run the code below as part of a larger system, as an accdb file the split database is correctly connected to the appropriate data source, external hard drive or university server.
I can nominate either source and the connection is completed correctly.
If I run the exact same code as an accde file, converted immediately after running the accdb, the code appears to run correctly but the data source is not changed.
The fact that the accde file is created is proof in itself of no coding errors.
I have tried this multiple times with the accdb and converted to accde immediately after a successful test and get the same result every time.
If I do the source change in the accdb file then run the accde without a source change, all functions operate normally.
I hope you can understand the problem from this description, I certainly don't understand the problem as it occurs.

Public Sub re_Link()
    Dim T       As TableDef
    Dim td      As TableDefs
    Dim sSource As String
    Dim nNum2 As Integer
    Dim nNum1 As Integer
    nRed = 255
    nGrn = 0
    nCng = 0
    Me.btnGauge.Visible = True
    On Error Resume Next
    Set td = oDB.TableDefs
    nNum1 = td.Count
    nNum2 = 1
    sSource = TempVars!src & "_be.accdb"
    For Each T In td
        If T.Connect <> ";DATABASE=" & sSource Then
            T.Connect = ";DATABASE=" & sSource
            T.RefreshLink
            doBar nNum1, nNum2
            nNum2 = nNum2 + 1
        End If
    Next
    Set T = Nothing
    Set td = Nothing
End Sub

Private Sub doBar(nNum1 As Integer, nNum2 As Integer)
    Dim nWidth As Long
    nWidth = Int(((nNum2 / nNum1) * 100))
    If nCng < nWidth Then
        nGrn = IIf(nGrn >= 255, 255, IIf(nRed = 255, nGrn + 5, nGrn))
        nRed = IIf(nRed <= 0, 0, IIf(nGrn = 255, nRed - 5, nRed))
        nCng = nWidth
        Me.btnGauge.BackColor = RGB(nRed, nGrn, 0)
    End If
    If nWidth > 12 Then
        Me.btnGauge.Left = Me.btnGauge.Left - 6
        Me.btnGauge.Width = nWidth * 40
    End If
    Me.btnGauge.Caption = nWidth & "%"
    DoEvents
End Sub

 

[LarryE]

No I do not understand the problem. Converting a file to a .accde file only makes the VBA code not accessible. It has nothing to do with the data source. What makes you think it does?

 

[CJ_London]

suggest put some msgbox’s to display variable values so you can check the accde

ODB does not seem appear to have been declared or populated

do you have option explicit at the top of every module?

 

[MajP]

I would be interested in these tests:

   sSource = TempVars!src & "_be.accdb"
   debug.print "Source: " & sSource
    For Each T In td
        debug.print "TName Connect : " & T.name & " " & T.Connect
        If T.Connect <> ";DATABASE=" & sSource Then
            T.Connect = ";DATABASE=" & sSource
            debug.print "New Connect: " & T.connect
            T.RefreshLink

 

[John Sh]

suggest put some msgbox’s to display variable values so you can check the accde

ODB does not seem appear to have been declared or populated

do you have option explicit at the top of every module?

Apologies. Odb is a variable in a public function and the other "undeclared" variables are private to the module.

 

[John Sh]

I have modified the "for each" section of the re-link procedure as below and changed the two "nNum" variables to private.
The "dobar" procedure now runs before the "T.Connect <> ";DATABASE=" and no variables are passed to dobar.
For whatever reason, this has solved the problem.

Private Sub re_Link()
    Dim T       As TableDef
    Dim td      As TableDefs
    Dim sSource As String
    nRed = 255
    nGrn = 0
    nCng = 0
    Me.btnGauge.Visible = True
    On Error Resume Next
    Set td = oDB.TableDefs
    nNum1 = td.Count         >>>>>>>>>>>>>>>>> now private
    nNum2 = 0
    sSource = TempVars!src & "_be.accdb"
    For Each T In td
        doBar               >>>>>>>>>>>>>>>> no variables passed  and moved from after t.rfresh
        If T.Connect <> ";DATABASE=" & sSource Then
            T.Connect = ";DATABASE=" & sSource
            T.RefreshLink
        End If
    Next
    Set T = Nothing
    Set td = Nothing
End Sub

Private Sub doBar()
    Dim nWidth As Long
    nWidth = Int(((nNum2 / nNum1) * 100))
    If nCng < nWidth Then
        nGrn = IIf(nGrn >= 255, 255, IIf(nRed = 255, nGrn + 5, nGrn))
        nRed = IIf(nRed <= 0, 0, IIf(nGrn = 255, nRed - 5, nRed))
        nCng = nWidth
        Me.btnGauge.BackColor = RGB(nRed, nGrn, 0)
    End If
    If nWidth > 12 Then
        Me.btnGauge.Left = Me.btnGauge.Left - 6
        Me.btnGauge.Width = nWidth * 40
    End If
    nNum2 = nNum2 + 1     >>>>>>>>>>>>>>>> moved from re-link
    Me.btnGauge.Caption = nWidth & "%"
    DoEvents
End Sub

I thank you both for your input.
John

 

[Josef P.]

I would remove On Error Resume Next and replace it with explicit error handling to find out the issue.