适配Pervasive Server存储过程的Excel VBA代码修改求助

Got it, let's fix up that VBA code to work with your Pervasive stored procedure properly. Here's the adjusted version with all your requirements met, plus fixes for some bugs in the original code:

Function Sproc() As Variant
    Dim cnn As ADODB.Connection
    Dim rst As ADODB.Recordset
    Dim ConnectionString As String
    Dim StrSproc As String
    
    ' Assign your full connection string (escaped double quotes for VBA syntax)
    ConnectionString = "Provider=MSDASQL.1;Persist Security Info=True;Extended Properties=""DSN=global_EGC;ServerName=fah2.1583;UID=UserIDName;PWD=password;ArrayFetchOn=1;ArrayBufferSize=8;TransportHint=TCP;DBQ=GLOBALEGC;ClientVersion=11.31.017.000;CodePageConvert=1252;PvClientEncoding=CP1252;PvServerEncoding=CP1252;AutoDoubleQuote=0;"""
    
    Set cnn = New ADODB.Connection
    On Error GoTo SQL_ConnectionError
    ' Open the database connection
    cnn.Open ConnectionString
    On Error GoTo 0
    
    ' Set timeout to 15 minutes (adjust if your procedure runs longer)
    cnn.CommandTimeout = 900
    
    ' Build stored procedure call with parameter from Sheet1!A1
    ' Add SET NOCOUNT ON to avoid extra result sets that cause errors
    StrSproc = "SET NOCOUNT ON; CALL EGC_Expl_BOM_TT('" & Replace(Sheet1.Range("A1").Value, "'", "''") & "')"
    
    Set rst = New ADODB.Recordset
    On Error GoTo SQL_StatementError
    ' Execute the procedure and retrieve results
    rst.Open StrSproc, cnn
    On Error GoTo 0
    
    ' Handle results: return first field value, or uncomment to output full dataset
    If Not rst.EOF And Not rst.BOF Then
        ' Return first value of the result set
        Sproc = IIf(IsNull(rst.Fields(0).Value), "(BLANK)", rst.Fields(0).Value)
        
        ' Optional: Uncomment to dump full results to Sheet2 starting at A1
        ' Sheet2.Cells.Clear
        ' Sheet2.Range("A1").CopyFromRecordset rst
    Else
        Sproc = "No results returned"
    End If
    
    ' Clean up database objects
    rst.Close
    cnn.Close
    Set rst = Nothing
    Set cnn = Nothing
    
    Exit Function

SQL_ConnectionError:
    MsgBox "Error connecting to the server / database. Please check the connection string."
    Sproc = "Connection Error"
    ' Clean up partial connections
    If Not cnn Is Nothing Then
        If cnn.State = adStateOpen Then cnn.Close
        Set cnn = Nothing
    End If
    Exit Function

SQL_StatementError:
    MsgBox "Error with the SQL syntax. Please check StrSproc."
    Debug.Print StrSproc ' Output problematic SQL to Immediate Window for debugging
    Sproc = "SQL Error"
    ' Clean up partial resources
    If Not rst Is Nothing Then
        If rst.State = adStateOpen Then rst.Close
        Set rst = Nothing
    End If
    If Not cnn Is Nothing Then
        If cnn.State = adStateOpen Then cnn.Close
        Set cnn = Nothing
    End If
    Exit Function
End Function

Key Changes & Explanations: #

• Exact Connection String: I plugged in your full connection string, escaping inner double quotes (required in VBA to preserve the extended properties format).
• Fixed Recordset Bug: The original code incorrectly declared rst as an ADODB.Connection instead of ADODB.Recordset—this was a critical error that would break execution.
• Safe Parameter Handling: The code pulls the part number from Sheet1!A1 and uses Replace() to escape single quotes, preventing syntax errors if your part number has apostrophes.
• SET NOCOUNT ON: This suppresses SQL's "rows affected" message, which often causes unexpected errors when retrieving recordsets in Excel.
• Proper Resource Cleanup: Added code to close and release database objects even if errors occur, preventing leftover connections to your Pervasive server.
• Improved Error Feedback: The function returns a clear error message instead of #VALUE!, and the debug print lets you inspect the generated SQL if something fails.

How to Use: #

1. Open your Excel file, press Alt + F11 to launch the VBA Editor.
2. Right-click your workbook in the Project Explorer > Insert > Module.
3. Paste the code into the module.
4. Reference the ADODB library: Go to Tools > References, check "Microsoft ActiveX Data Objects x.x Library" (use the latest version available, like 6.1).
5. In any cell, enter =Sproc() to run the function. If you uncomment the optional code, the full result set will populate Sheet2.

内容的提问来源于stack exchange，提问作者Mike Myers