Evening guys,
I have a user getting a runtime error on the below code (near the bottom "RUN LINKDB()" is where the debugger highlights. It works great on my computer but for some reason not on his. I checked all his reference libraries and they match mine. Any thoughts?
The on load code for my main form:
the Run linkDB line calls the below module:
I have a user getting a runtime error on the below code (near the bottom "RUN LINKDB()" is where the debugger highlights. It works great on my computer but for some reason not on his. I checked all his reference libraries and they match mine. Any thoughts?
The on load code for my main form:
Code:
Private Sub Form_Load()
Dim suser As String
Dim sSQL As String
Dim CurUser As String
suser = Environ("username") 'Name of real person
'MsgBox "sUser = " & sUser
'MsgBox "curUser = " & CurrentUser()
Forms![enable macro page]![Text210] = suser
'If suser = "clinton.pilgrim" Then
'MsgBox ("..... ..... ..... ....."), vbOKOnly
'DoCmd.OpenForm "Misc"
'Exit Sub
'End If
'-----------------------------
curtbl = CurrentDb.TableDefs("help table").Connect
On Error GoTo con_error
Dim cnn As ADODB.Connection
Set cnn = New ADODB.Connection
'Set the provider property to the OLE DB Provider for ODBC.
cnn.Provider = "MSDASQL"
' Open a connection using an ODBC DSN.
cnn.ConnectionString = "driver={SQL Server};" & _
curtbl
cnn.Open
' Find out if the attempt to connect worked.
If cnn.State = adStateOpen Then
Else
MsgBox "Sorry. The server is not responding."
End If
' Close the connection.
cnn.Close
backswap.backgroundswap
Dim intStore As Integer
'Count of uncomplete jobs that are past the Expected Completion Date
intStore = DCount("[JobNumber]", "[tblJobs]", "[ExpectedCompletionDate] <=Now() AND [Complete] =0")
'If count of uncomplete jobs is zero display switchboard
'Else display message box detailing amount of jobs
'and give the user the option as to whether to view these or not.
If intStore = 0 Then
DoCmd.OpenForm "Start Page", acNormal
Exit Sub
Else
If MsgBox("There are " & intStore & " uncompleted jobs" & _
vbCrLf & vbCrLf & "Would you like to see these now?", _
vbYesNo, "You Have Uncomplete Jobs...") = vbYes Then
DoCmd.Minimize
DoCmd.OpenForm "frmReminders", acNormal
Else
DoCmd.OpenForm "Start Page", acNormal
Exit Sub
End If
End If
con_Exit:
Exit Sub
con_error:
Dim resp
Dim resp2
resp = MsgBox("Server Connection Failed!" & vbCrLf & vbCrLf & "Would you like to change the name of your base server?", vbYesNo)
If resp = vbYes Then
On Error Resume Next
[B]Run linkDB()
[/B] Else
resp2 = MsgBox("Server Connection Failed!" & vbCrLf & vbCrLf & "Would you like to retry the connection?", vbYesNo)
If resp2 = vbNo Then
Application.Quit
Else
DoCmd.Close acForm, "enable macro page"
DoCmd.OpenForm "enable macro page", acNormal
End If
End If
End Subthe Run linkDB line calls the below module:
Code:
Option Compare Database
Public Function linkDB()
On Error GoTo err_update
Dim dbs As DAO.Database
Dim tdf As DAO.TableDef
Dim Newserver As String
Newserver = InputBox("Enter the network name of the server you wish to use:" & vbCrLf & vbCrLf & "Example: SSC-CS-SQL02", _
"Bind To New Server")
'If the user clicks cancel or gives a null length responce the server change will abort
If Newserver <> "" Then
MsgBox "Server Selected: " & Newserver & vbCrLf & vbCrLf & "Please be patient as the server is located. This process can take up to a minute."
Set dbs = CurrentDb()
' Loop through TableDefs collection, only processing
' the table if it already has a Connection property.
' (all other tables are local ... not linked)
For Each tdf In dbs.TableDefs
If tdf.Connect <> "" Then
tdf.Connect = "ODBC;DRIVER={SQL Server};SERVER=" & Newserver & ";DATABASE=QP3;Trusted_Connection=Yes"
tdf.RefreshLink
End If
Next
Else
MsgBox "Server change request canceled or invalid response given."
Application.Quit
End If
exit_fun:
Exit Function
err_update:
MsgBox "The update experienced errors and will be canceled. This is likely because the server requested is not available."
Application.Quit
End Function
)
