Dim Cnn
Dim Rst
Dim strCnn
Set Cnn = CreateObject("ADODB.Connection")
Set Rst =CreateObject("ADODB.Recordset")
strCnn="rovider=SQLOLEDB.1assword=XXXersist Security Info=True;User ID=XXX;Initial Catalog=DB_Name;Data Source=DB_IPAddress;"
Cnn.Open strCnn
If Cnn.State=0 Then
Reporter.ReportEvent micFail,"testing","数据库连接失败"
else
Reporter.ReportEvent micPass, "testing","数据库连接成功"
End If
If Cnn.State<>0 Then
strsql="select * from tb_General_Info"
' 示例: strConnInfo="DRIVER=SQL Server;SERVER=192.168.0.7;UID=WD=;APP=Microsoft Office 2003;DATABASE=UserDataDB"
' strSelectSql=""
' objectProperty="Money"
' Call selectSQL(strConnInfo,strSelectSql,objectProperty)
'*********************************************************
Dim addConn,connRes
Dim i
'创建数据库对象
Set addConn=CreateObject ("adodb.Connection")
'使用连接打开数据库
addConn.Open strConnInfo
'判断是否打开数据库成功
If addConn.State=1 Then
Reporter.ReportEvent micPass ,"成功","连接数据库成功"
else
Reporter.ReportEvent micFail,"失败","连接数据库失败"
addConn.Close
Set addConn=nothing
End If
'创建数据库记录集对象
Set connRes=CreateObject ("adodb.RecordSet")
'执行数据库查询
connRes.Open strSelectSql,addConn
connRes.MoveFirst()
'判断表名是否存在,不存在着添加
intDataCount=DataTable.GetSheetCount
For intStat=1 to intDataCount
strDataName=DataTable.GetSheet(intStat).Name
If strDataName="SQL_Results" Then
Exit for
else
DataTable.AddSheet "SQL_Results"
End If
Next
'获取表内列数
intParameter=DataTable.GetSheet("SQL_Results").GetParameterCount
varStat=true
'判断如果列数为0直接添加,如果不是则把状态转成False
If intParameter=0 Then
DataTable.GetSheet("SQL_Results").AddParameter objectProperty,null
else
varStat=False
End If
'当varStat=False执行获取列明并进行判断
Do while varStat=False
For intStartParameter=1 to intParameter
strParameterName=DataTable.GetSheet("SQL_Results").GetParameter(intStartParameter).Name
If strParameterName=objectProperty Then
Exit do
else
If intStartParameter=intParameter Then
DataTable.GetSheet("SQL_Results").AddParameter objectProperty,"null"
Exit do
End If
End If
Next
Loop
i=1
'获取数据库结果并写入DataTbale中
Do
DataTable.GetSheet("SQL_Results").SetCurrentRow (i)
DataTable.Value (objectProperty,"SQL_Results")=connRes.Fields (objectProperty)
i=i+1
connRes.MoveNext
Loop until connRes.EOF
connRes.Close
addConn.Close
Set connRes=nothing
Set addConn=nothing
End Function
不过也只能获取1列作者: cellule 时间: 2012-8-14 10:45
Function selectSQL(strConnInfo,strSelectSql,objectProperty)
'*********************************************************
' 作者:cellule
' 示例: strConnInfo="DRIVER=SQL Server;SERVER=192.168.0.7;UID=saWD=sa;APP=Microsoft Office 2003;DATABASE=UserDataDB"
' strSelectSql=""
' objectProperty="Money"
' Call selectSQL(strConnInfo,strSelectSql,objectProperty)
'*********************************************************
Dim addConn,connRes
Dim i
'创建数据库对象
Set addConn=CreateObject ("adodb.Connection")
'使用连接打开数据库
addConn.Open strConnInfo
'判断是否打开数据库成功
If addConn.State=1 Then
Reporter.ReportEvent micPass ,"成功","连接数据库成功"
else
Reporter.ReportEvent micFail,"失败","连接数据库失败"
addConn.Close
Set addConn=nothing
End If
'创建数据库记录集对象
Set connRes=CreateObject ("adodb.RecordSet")
'执行数据库查询
connRes.Open strSelectSql,addConn
connRes.MoveFirst()
'判断表名是否存在,不存在着添加
intDataCount=DataTable.GetSheetCount
For intStat=1 to intDataCount
strDataName=DataTable.GetSheet(intStat).Name
If strDataName="SQL_Results" Then
Exit for
else
DataTable.AddSheet "SQL_Results"
End If
Next
'获取表内列数
intParameter=DataTable.GetSheet("SQL_Results").GetParameterCount
varStat=true
'判断如果列数为0直接添加,如果不是则把状态转成False
If intParameter=0 Then
DataTable.GetSheet("SQL_Results").AddParameter objectProperty,"test"
else
varStat=False
End If
'当varStat=False执行获取列名并进行判断
Do while varStat=False
For intStartParameter=1 to intParameter
strParameterName=DataTable.GetSheet("SQL_Results").GetParameter(intStartParameter).Name
If strParameterName<>objectProperty Then
If intStartParameter=intParameter Then
DataTable.GetSheet("SQL_Results").AddParameter objectProperty,null
Exit do
End If
End If
Next
Loop
'获取sheet的rows
intDataRow=DataTable.GetSheet("SQL_Results").GetRowCount
'如果rows小于1直接赋值i=1
If intDataRow<=1 Then
i=1
else
strStat=false
intNUM=int(intDataRow)
Do
DataTable.GetSheet("SQL_Results").SetCurrentRow (intNUM)
'获取值
strValue=trim(DataTable.Value(objectProperty,"SQL_Results"))
'判断是否为空,为空着行-1,不为空着strStat=True
If strValue=null Then
intNUM=intNUM-1
else
i=intNUM
strStat=true
End If
Loop until strStat=true
End If
'获取数据库结果并写入DataTbale中
Do
DataTable.GetSheet("SQL_Results").SetCurrentRow (i)
DataTable.Value (objectProperty,"SQL_Results")=connRes.Fields (objectProperty)
i=i+1
connRes.MoveNext
Loop until connRes.EOF
connRes.Close
addConn.Close
Set connRes=nothing
Set addConn=nothing
End Function作者: cellule 时间: 2012-8-14 10:46
以上的请大家帮忙优化作者: shingo0109 时间: 2012-8-14 10:49
我这边也写了个, 看看能否满足LZ要求, 我用的是LocalSheet的:
i = 1
Do While Not rs.EOF
DataTable.LocalSheet.SetCurrentRow(i)
For j = 0 to rs.Fields.Count -1
If i = 1 Then
DataTable.LocalSheet.AddParameter rs.Fields(j).Name, rs.Fields(j).Value
Else
DataTable(rs.Fields(j).Name, dtLocalSheet) = rs.Fields(j).Value
End If
Next
rs.MoveNext
i = i + 1
Loop作者: betty7zhang 时间: 2012-8-14 14:53 回复 5#shingo0109
Function ImportDataFromDB(sql)
'Connect SQLServer
Set Con=CreateObject("ADODB.Connection")
Con.open "DRIVER=SQL Server;SERVER=XXX;UID=XXXWD=XXX;DATABASE=DB_Name"
'query data from table
Set Record=CreateObject("ADODB.Recordset")
'sql="select * from dbo.Tokenization_Service"
Record.open sql,con
Record.MoveFirst
' no result
If Record.EOF and Record.BOF Then
Record.Close
Reporter.ReportEvent micFail,"test","query fail"
Else
For i = 0 to Record.Fields.Count-1
DataTable.GlobalSheet.AddParameter Record(i).name, Record(i).value
Next
Record.movenext
j=2
Do while not(Record.EOF)
For i = 0 to Record.Fields.Count-1
DataTable.SetCurrentRow(j)
DataTable.value(i+1,1)=Record(i).value
Next
Record.movenext
j=j+1
Loop
End If
Record.close
Set Record=nothing
Con.close
Set Con=nothing
End Function作者: shingo0109 时间: 2012-8-14 15:23 本帖最后由 shingo0109 于 2012-8-14 15:37 编辑