VB6应用中MSDataShape查询迁移至XML（SQL数据塑形）方案问询

针对你依赖MSDataShape提供程序的VB6遗留系统，以下是两种替代SHAPE查询的可行方案，均可生成兼容MSHFlexGrid的嵌套ADO Recordset：

方案1：用SQL Server FOR XML生成嵌套XML，再加载为ADO Recordset #

步骤1：将SHAPE查询转换为FOR XML语句 #

原SHAPE查询的父子关联逻辑，可以通过FOR XML PATH构造嵌套XML结构，替代SHAPE的APPEND和Relate逻辑：

SELECT
    pc.[PRYL COMM Record ID],
    pc.[PRYL COMM AR SALE Document #],
    pc.[PRYL COMM Dated] AS Dated,
    ar.[AR SALE Ext Document #] AS [AR Doc],
    pc.[PRYL COMM Customer Name] AS [Customer Name],
    pc.[PRYL COMM Salesperson] AS [Salesperson],
    pc.[PRYL COMM Salesperson Number] AS [Sls Num],
    pc.[PRYL COMM Salesperson Percent] AS [Percent],
    pc.[PRYL COMM Location] AS [Location],
    pc.[PRYL COMM Price] AS Price,
    pc.[PRYL COMM Cost] AS Cost,
    pc.[PRYL COMM Profit] AS Profit,
    pc.[PRYL COMM Margin] AS Margin,
    pc.[PRYL COMM Calc Cost] AS [Calc Cost],
    pc.[PRYL COMM Calc Profit] AS [Calc Profit],
    pc.[PRYL COMM Calc Margin] AS [Calc Margin],
    pc.[PRYL COMM Comm Amount] AS [Comm Amount],
    pc.[PRYL COMM ESP Amount] AS [Fixed $],
    pc.[PRYL COMM Spiff Amount] AS [Spiff $],
    pc.[PRYL COMM Delete] AS [Delete],
    (
        SELECT
            pcd.[PRYL COMMD Record ID],
            pcd.[PRYL COMMD Header ID],
            pcd.[PRYL COMMD AR SALED ID],
            pcd.[PRYL COMMD Pay YN] AS [Pay YN],
            pcd.[PRYL COMMD Qty] AS [Qty],
            pcd.[PRYL COMMD Model Number] AS [Model Number],
            pcd.[PRYL COMMD Serial Number] AS [Serial Number],
            pcd.[PRYL COMMD Unit Price] AS [Price],
            pcd.[PRYL COMMD Unit Cost] AS [Cost],
            pcd.[PRYL COMMD Profit] AS [Profit],
            pcd.[PRYL COMMD Calc Cost] AS [Calc Cost],
            pcd.[PRYL COMMD Calc Profit] AS [Calc Profit],
            pcd.[PRYL COMMD Calc Margin] AS [Calc Margin],
            pcd.[PRYL COMMD Comm Amount] AS [Comm Amount],
            pcd.[PRYL COMMD Comm Percent] AS [Comm %],
            pcd.[PRYL COMMD ESP Amount] AS [Fixed $],
            pcd.[PRYL COMMD Spiff Amount] AS [Spiff $],
            pcd.PRYLCOMMDExpInvCost AS [Exp Inv],
            pcd.[PRYL COMMD Notes] AS [Notes],
            pcd.[PRYL COMMD Costed By] AS [Cost by]
        FROM [Pyrl - Commission Detail] pcd
        WHERE pcd.[PRYL COMMD Header ID] = pc.[PRYL COMM Record ID]
        FOR XML PATH('ChildCMD'), TYPE
    )
FROM [Pyrl - Commission] pc
JOIN [AR Sales] ar ON pc.[PRYL COMM AR SALE Document #] = ar.[AR SALE Document #]
WHERE pc.[PRYL COMM Salesperson] = 'Trevor Janok' 
  AND pc.[PRYL COMM Payroll ID] = '62'
FOR XML PATH('ParentCMD'), ROOT('CommissionData')

步骤2：在VB6中加载XML为嵌套Recordset #

执行上述SQL获取XML字符串后，直接加载为ADO Recordset，结构与SHAPE查询结果完全一致：

Dim rsNested As ADODB.Recordset
Dim xmlResult As String
Dim conn As ADODB.Connection

' 初始化数据库连接（复用你现有连接逻辑）
Set conn = New ADODB.Connection
conn.Open "你的数据库连接字符串"

' 执行FOR XML查询获取XML结果
xmlResult = conn.Execute("上述FOR XML语句").Fields(0).Value

' 将XML加载为嵌套Recordset
Set rsNested = New ADODB.Recordset
rsNested.Open xmlResult, , adOpenStatic, adLockReadOnly, adCmdFile

' 绑定到MSHFlexGrid
Set mshFlexGrid.DataSource = rsNested

方案2：手动创建嵌套ADO Recordset #

如果不想依赖XML，可以手动构造父Recordset，并为每条父记录关联子Recordset，保留数据绑定功能：

步骤1：定义父Recordset结构并填充数据 #

Dim rsParent As ADODB.Recordset
Dim rsParentData As ADODB.Recordset
Dim rsChild As ADODB.Recordset
Dim conn As ADODB.Connection

Set conn = New ADODB.Connection
conn.Open "你的数据库连接字符串"

' 创建父Recordset，包含原SHAPE父表字段+子Recordset字段
Set rsParent = New ADODB.Recordset
With rsParent.Fields
    .Append "[PRYL COMM Record ID]", adInteger ' 按实际字段类型调整
    .Append "[PRYL COMM AR SALE Document #]", adVarChar, 50
    .Append "Dated", adDate
    .Append "[AR Doc]", adVarChar, 50
    .Append "[Customer Name]", adVarChar, 100
    .Append "[Salesperson]", adVarChar, 50
    .Append "[Sls Num]", adVarChar, 20
    .Append "[Percent]", adDouble
    .Append "[Location]", adVarChar, 50
    .Append "Price", adCurrency
    .Append "Cost", adCurrency
    .Append "Profit", adCurrency
    .Append "Margin", adDouble
    .Append "[Calc Cost]", adCurrency
    .Append "[Calc Profit]", adCurrency
    .Append "[Calc Margin]", adDouble
    .Append "[Comm Amount]", adCurrency
    .Append "[Fixed $]", adCurrency
    .Append "[Spiff $]", adCurrency
    .Append "[Delete]", adBoolean
    ' 添加子Recordset字段，类型为adDispatch
    .Append "ChildCMD", adDispatch
End With
rsParent.Open

' 加载父表数据
Set rsParentData = conn.Execute("SELECT pc.[PRYL COMM Record ID], pc.[PRYL COMM AR SALE Document #], pc.[PRYL COMM Dated] AS Dated, ar.[AR SALE Ext Document #] AS [AR Doc], pc.[PRYL COMM Customer Name] AS [Customer Name], pc.[PRYL COMM Salesperson] AS [Salesperson], pc.[PRYL COMM Salesperson Number] AS [Sls Num], pc.[PRYL COMM Salesperson Percent] AS [Percent], pc.[PRYL COMM Location] AS [Location], pc.[PRYL COMM Price] AS Price, pc.[PRYL COMM Cost] AS Cost, pc.[PRYL COMM Profit] AS Profit, pc.[PRYL COMM Margin] AS Margin, pc.[PRYL COMM Calc Cost] AS [Calc Cost], pc.[PRYL COMM Calc Profit] AS [Calc Profit], pc.[PRYL COMM Calc Margin] AS [Calc Margin], pc.[PRYL COMM Comm Amount] AS [Comm Amount], pc.[PRYL COMM ESP Amount] AS [Fixed $], pc.[PRYL COMM Spiff Amount] AS [Spiff $], pc.[PRYL COMM Delete] AS [Delete] FROM [Pyrl - Commission] pc JOIN [AR Sales] ar ON pc.[PRYL COMM AR SALE Document #] = ar.[AR SALE Document #] WHERE pc.[PRYL COMM Salesperson] = 'Trevor Janok' AND pc.[PRYL COMM Payroll ID] = '62'")

' 遍历父数据，关联子Recordset
Do While Not rsParentData.EOF
    rsParent.AddNew
    ' 复制父字段值
    rsParent.Fields("[PRYL COMM Record ID]").Value = rsParentData.Fields("[PRYL COMM Record ID]").Value
    rsParent.Fields("[PRYL COMM AR SALE Document #]").Value = rsParentData.Fields("[PRYL COMM AR SALE Document #]").Value
    rsParent.Fields("Dated").Value = rsParentData.Fields("Dated").Value
    rsParent.Fields("[AR Doc]").Value = rsParentData.Fields("[AR Doc]").Value
    ' 依次复制其他父字段（省略重复代码）
    
    ' 加载当前父记录对应的子数据
    Set rsChild = conn.Execute("SELECT * FROM [Pyrl - Commission Detail] WHERE [PRYL COMMD Header ID] = " & rsParentData.Fields("[PRYL COMM Record ID]").Value)
    Set rsParent.Fields("ChildCMD").Value = rsChild
    
    rsParent.Update
    rsParentData.MoveNext
Loop

rsParentData.Close
Set rsParentData = Nothing

步骤2：绑定到MSHFlexGrid #

手动创建的嵌套Recordset完全兼容原SHAPE查询的绑定逻辑：

Set mshFlexGrid.DataSource = rsParent
' 保留原网格的显示配置（如行高、列宽、折叠逻辑等）

关键说明 #

• 两种方案均支持带参数的重复查询：只需修改SQL中的筛选条件（如Salesperson、Payroll ID）重新执行即可，无需保存XML文件。
• 方案1依赖SQL Server的FOR XML功能，方案2纯ADO操作，无额外依赖。

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