1

約 10 年前にクライアント向けに作成された VB6 アプリケーションにアクセスしようとしていますが、断続的にこのエラーが発生し続けます。アプリケーションには起動時にログインが必要であり、提供されたログインを入力すると (100% 正しいと確信しています)、次のエラーが表示されます。

実行時エラー '3709'
要求された操作には、現在のプロバイダーでサポートされていない OLE DB セッション オブジェクトが必要です。

本当に奇妙なのは、昨夜、まったく問題なくログインできたことです。ただし、約 1 週間前にこの問題が発生しましたが、数日間町を離れていたため、戻ってきたときに再びログインできました。その最初のインスタンスの前に、私は問題なくログインできました。同様の質問が既に投稿されていることに気付きましたが、与えられた解決策はうまくいきませんでした。データベース接続の確立に関するコードは次のとおりです。Serv1、Use1、PW1 などは、サーバー名/ユーザー名/パスワードのフィラーに過ぎないことに注意してください。

Public Function GetConnected()

' This function decides which server to connect and makes the connection

'Determines which connection string to use
If frmSplash.Text1 = "1" Or frmSplash.Text1 = "apc" Then 'server location
'determines if the logon contains '1' or 'apc'
    'APC connection code
    strSQLServerName = "(Serv1)"
    strSQLDBUserName = "Use1"
    strSQLDBPassword = "PW1"
    strSQLPort = ""

ElseIf frmSplash.Text1 = "2" Then
    'Laptop connection string
    strSQLServerName = "(Serv1)"
    strSQLDBUserName = "Use2"
    strSQLDBPassword = "PW2"
    strSQLPort = ""
Else
    'Client connection code
    strSQLServerName = "Serv2
    strSQLDBUserName = "Use3"
    strSQLDBPassword = "PW3"
    strSQLPort = ""
End If 'server location


    'If (m_DBConnection Is Nothing) Then
    Set m_DBConnection = New ADODB.Connection
    'End If

    SessionLocation = frmSplash.LocationCombo.Text

'***************************************
'Connecs to database based on location
    If frmSplash.LocationCombo.Text = "Loc1" Then
    strSQLDBName = "ServLoc1"
    ElseIf frmSplash.LocationCombo.Text = "Loc2" Then
    strSQLDBName = "ServLoc2"
    Else
    strSQLDBName = "ServLoc3"
    End If
'**************************

'Builds connection string
    m_DBConnection.ConnectionString = "Provider=SQLOLEDB;" & _
    "Data Source = '" & strSQLServerName & strSQLPort & "';" & _
    "uid=" & strSQLDBUserName & ";" & _
    "pwd=" & strSQLDBPassword & ";" & _
    "Database=" & strSQLDBName & ";"  

On Error GoTo errorhandler
    m_DBConnection.Open
    If (m_DBConnection Is Nothing) Then
        MsgBox "Connection Failed"
    End If
Exit Function

errorhandler:
    MsgBox ("Problem with the Server")
    'MsgBox "Connection State " & GetState(m_DBConnection.State)
End Function

Public Function ExecuteSQL(strSQL As String) As ADODB.Recordset
    'Dim cmd As ADODB.Command

    Set cmd = New ADODB.Command

    **cmd.ActiveConnection = m_DBConnection** <-----(Error occurs here)
    cmd.CommandType = adCmdText
    cmd.CommandText = strSQL

    Set ExecuteSQL = cmd.Execute

Exit Function

変数の定義:

Public strSQLServerName  'Holds the name of the SQL Server
Public strSQLDBUserName  'Holds the user name (for SQL Server Authentication)
Public strSQLDBPassword  'Holds the password (for SQL Server Authentication)
Public strSQLDBName      'Holds name of a database on the server
Public strSQLPort        'Holds the Port Number
Public SessionUser As Integer    ' To Track the type of User (3 Levels)
Public SessionLocation As String ' To Track the DB throughout the Session
Public m_DBConnection As ADODB.Connection
Public cmd As ADODB.Command

VB6で作業するのはこれが初めてで、少し途方に暮れています。なぜそれが時々機能し、他の人が機能しないのか理解できません。誰かが何か洞察を持っているなら、彼らは非常に高く評価されます.

4

1 に答える 1