这个代码的原理是把Excel的数据当做数据库里的数据一样处理，可以对Excel用select来检索需要的数据，然后把数据以键值对的形式保存到oDict里，方便在用例层来调用
1 Class oDataDic 2 3 Private oDic 4 Public oWorkBookPath 5 Public oSheetName 6 Public oRowNo 7 8 Private Sub Class_Initialize 9 'oWorkBookPath = getTestDataFromQC_QTP("业务系统测试数据") 10 11 oWorkBookPath = Environment.Value("ProductDir") & "业务系统测试数据.xls" 'strTestDataPath 12 End Sub 13 14 Public Default Function Load(oSheetName, oRowNo) 15 With Me 16 .oWorkBookPath = oWorkBookPath 17 .oSheetName = oSheetName 18 .oRowNo = oRowNo 19 End With 20 21 BuildContext 22 Set Load = oDic 23 End Function 24 25 Public Function GetExcelRecordCount(oSheetName, CaseNO) 26 Dim oConn, oRS, arrData, x 27 Set oConn = CreateObject("ADODB.Connection") 28 Set oRS = CreateObject("ADODB.RecordSet") 29 30 oConn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _ 31 "Data Source=" & oWorkBookPath & ";" & _ 32 "Extended Properties=""Excel 8.0;HDR=Yes;"";" 33 34 If IsNumeric(CaseNO) Then 35 sQuery = "select * from [" & oSheetName & "$]" & " where 测试用例编号 = " & CaseNO 36 else 37 sQuery = "select * from [" & oSheetName & "$]" & " where 测试用例名称 = " & "'" & CaseNO & "'" 38 End If 39 40 oRS.Open sQuery, oConn, 3, 3, 1 41 42 ' rows = oRS.Index 43 GetExcelRecordCount = oRS.RecordCount 44 ' num = oRS.GetRows 45 ' Dim x 46 ' For x= 2 To oRS.RecordCount + 1 47 ' If CStr(oRS.Fields(0)) = CaseNO Then 48 ' msgbox x 49 ' CStr(oRS.Fields(1)) 50 ' Exit For 51 ' Else 52 ' oRS.MoveNext 53 ' End If 54 ' Next 55 ' Set oDic = CreateObject("Scripting.Dictionary") 56 ' 57 ' For x = 0 To oRS.Fields.Count - 1 58 ' With oDic 59 ' .Add "" & oRS(x).Name, "" & oRS.Fields(x) 60 ' End With 61 ' Next 62 ' 63 ' Set GetExcelRecordCount = oDic 64 65 End Function 66 67 Public Function LoadExcelRecord(oSheetName, CaseNO, oRowNo) 68 ' On Error Resume Next 69 Dim oConn, oRS, arrData, x 70 Set oConn = CreateObject("ADODB.Connection") 71 Set oRS = CreateObject("ADODB.RecordSet") 72 73 oConn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _ 74 "Data Source=" & oWorkBookPath & ";" & _ 75 "Extended Properties=""Excel 8.0;HDR=Yes;"";" 76 77 If IsNumeric(CaseNO) Then 78 sQuery = "select * from [" & oSheetName & "$]" & " where 测试用例编号 = " & CaseNO 79 else 80 sQuery = "select * from [" & oSheetName & "$]" & " where 测试用例名称 = " & "'" & CaseNO & "'" 81 End If 82 oRS.Open sQuery, oConn, 3, 3, 1 83 84 85 86 ' For x= 2 To oRS.RecordCount + 1 87 ' If CStr(oRS.Fields(0)) = CaseNO Then 88 ' msgbox x 89 ' CStr(oRS.Fields(1)) 90 ' Exit For 91 ' Else 92 ' oRS.MoveNext 93 ' End If 94 ' Next 95 96 For x= 2 To oRowNo - 1 : oRS.MoveNext : Next 97 98 Set oDic = CreateObject("Scripting.Dictionary") 99 100 For x = 0 To oRS.Fields.Count - 1 101 With oDic 102 .Add "" & oRS(x).Name, "" & oRS.Fields(x) 103 ' .Add cstr(oRS(x).Name), cstr(oRS.Fields(x)) 104 End With 105 Next 106 107 Set LoadExcelRecord = oDic 108 109 End Function 110 111 Private Function BuildContext 112 Dim oConn, oRS, arrData, x 113 114 Set oConn = CreateObject("ADODB.Connection") 115 Set oRS = CreateObject("ADODB.RecordSet") 116 117 oConn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _ 118 "Data Source=" & Me.oWorkBookPath & ";" & _ 119 "Extended Properties=""Excel 8.0;HDR=Yes;"";" 120 121 sQuery = "select * from [" & Me.oSheetName & "$]" 122 oRS.Open sQuery, oConn, 3, 3, 1 123 124 For x= 2 To oRowNo - 1 : oRS.MoveNext : Next 125 126 Set oDic = CreateObject("Scripting.Dictionary") 127 128 For x = 0 To oRS.Fields.Count - 1 129 With oDic 130 .Add "" & oRS(x).Name, "" & oRS.Fields(x) 131 ' .Add cstr(oRS(x).Name), cstr(oRS.Fields(x)) 132 End With 133 Next 134 135 ' Set oDic = Nothing 136 ' Set oRS = Nothing 137 ' Set oConn =Nothing 138 End Function 139 140 ' Private Property Let oDic(ByVal val) 141 ' Set oDic = val 142 ' End Property 143 ' 144 ' Private Property Get oDic() 145 ' Set oDic = oDic 146 ' End Property 147 End Class 148 149 150 Set mDataContext = New oDataDic