“没有为命令对象设置对象“?????????????
下面是这段代码!我在asp下调用inquiry,可是却弹出“没有为命令对象设置对象“
这是为什么呢?
Option Explicit
Private RS As Recordset, CN As Connection, rtnMessage As String
Private cDateStart As String, cDateEnd As String
Private cMoneyStart As String, cMoneyEnd As String
Public Property Get rtnMsg() As Variant
rtnMsg = rtnMessage
End Property
Public Property Let rtnMsg(ByVal vNewValue As Variant)
rtnMessage = vNewValue
End Property
Public Sub ConnectDB(Server As String, Database As String, UserID As String, PWD As String, Trusted As Boolean)
Dim tmpStr As String
On Error Resume Next
tmpStr = "Provider=SQLOLEDB.1;Persist Security Info=False;Initial Catalog=" + Database + ";Data Source=" + Server
If Trusted Then
tmpStr = tmpStr + ";Integrated Security=SSPI"
Else
tmpStr = tmpStr + ";User ID=" + UserID + ";PWD=" + PWD
End If
With CN
.ConnectionString = tmpStr
.CommandTimeout = 0
.Open
End With
If Err <> 0 Then
rtnMessage = "数据库连接失败: " + Err.Description
Else
rtnMessage = ""
End If
End Sub
Public Function Inquiry(DateStart As String, DateEnd As String, MoneyStart As String, MoneyEnd As String) As String
Dim tmpStr As String, colNum As Integer
Dim clientida As Integer
cClientType = ClientType
cMoneyStart = MoneyStart
cMoneyEnd = MoneyEnd
cDateStart = DateStart
cDateEnd = DateEnd
On Error Resume Next
If RS.State <> adStateClosed Then RS.Close
If CN.State = adStateClosed Then
rtnMessage = "数据库未连接!"
Exit Function
End If
CN.Execute "drop table #transorderheader"
Err.Clear
If IsDate(cDateStart) = False Or IsDate(cDateEnd) = False Then
rtnMessage = "输入日期数据有误!" + Chr(10) + Chr(13) + "Date Start: " + cDateStart + Chr(10) + Chr(13) + "Date End: " + cDateEnd
Exit Function
End If
tmpStr = "select soldtocontactid,orderid,orderdate,userid,ordernet from transorderheader where orderdate >= '" + _
cDateStart + "' and orderdate <= '" + cDateEnd + "'" + "and clientid=" + clientida + " and ordernet<=" + cMoneyEnd + _
" and ordernet>=" + cMoneyStart
RS.Open tmpStr, CN, adOpenStatic, adLockReadOnly
If Err <> 0 Then
rtnMessage = Err.Description
Exit Function
End If
If RS.RecordCount < 1 Then
Inquiry = ""
Exit Function
End If
tmpStr = "<TR><TD width=25%><font size=""2"">客户编号</font></TD>" + _
"<TD width=25%><font size=""2"">订单编号</font></TD>" + _
"<TD width=20%><font size=""2"">订单输入日期</font></TD>" + _
"<TD width=15%><font size=""2"">订单输入人员</font></TD>" + _
"<TD width=15%><font size=""2"">订单金额</font></TD></TR>"
Do While RS.EOF = False
tmpStr = tmpStr + "<TR><TD width=25%><font size=""2"">" + RS!soldtocontactid + "</font></TD>"
tmpStr = tmpStr + "<TD width=25%><font size=""2"">" + RS!orderid + "</font></TD>"
tmpStr = tmpStr + "<TD width=20%><font size=""2"">" + Trim(Str(RS!orderdate)) + "</font></TD>"
tmpStr = tmpStr + "<TD width=15%><font size=""2"">" + RS!UserID + "</font></TD>"
tmpStr = tmpStr + "<TD width=15%><font size=""2"">" + RS!ordernet + "</font></TD></TR>"
RS.MoveNext
Loop
Inquiry = tmpStr
End Function
Public Sub SaveXls()
Dim xlsName As String, rowNum As Integer
Dim xlsApp As Excel.Application, xlsBook As Excel.Workbook, xlsSheet As Excel.Worksheet
On Error Resume Next
If RS.State = adStateClosed Then
rtnMessage = "尚未得到查询数据!"
Exit Sub
End If
If RS.RecordCount < 1 Then
rtnMessage = "没有相关数据!"
Exit Sub
End If
Set xlsApp = CreateObject("Excel.Application")
If Err <> 0 Then
rtnMessage = "创建Excel应用失败: " + Err.Description
Exit Sub
End If
Set xlsBook = xlsApp.Workbooks.Add
If Err <> 0 Then
rtnMessage = "创建Excel工作簿失败: " + Err.Description
Exit Sub
End If
Set xlsSheet = xlsBook.Worksheets(1)
xlsSheet.Name = "订单查询清单"
xlsSheet.Cells(1, 1).Value = xlsSheet.Name
xlsSheet.Cells(1, 1).Font.Bold = True
xlsSheet.Cells(2, 1) = "客户编号"
xlsSheet.Cells(2, 2) = "订单编号"
xlsSheet.Cells(2, 3) = "订单输入日期"
xlsSheet.Cells(2, 4) = "输入人员"
xlsSheet.Cells(2, 5) = "订单金额"
RS.MoveFirst
rowNum = 3
Do While RS.EOF = False
xlsSheet.Cells(rowNum, 1).Value = RS!soldtocontactid
xlsSheet.Cells(rowNum, 2).Value = RS!orderid
xlsSheet.Cells(rowNum, 3).Value = RS!orderdate
xlsSheet.Cells(rowNum, 4).Value = RS!UserID
xlsSheet.Cells(rowNum, 5).Value = RS!ordernet
RS.MoveNext
rowNum = rowNum + 1
Loop
xlsSheet.Cells.Select
Selection.NumberFormatLocal = "@"
xlsSheet.Columns("C:C").Select
Selection.NumberFormatLocal = "yyyy-m-d h:mm"
xlsSheet.Range(Cells(1, 1), Cells(1, 8)).Select
With Selection
.HorizontalAlignment = xlCenter
.Merge
End With
xlsSheet.Cells.Select
Selection.Columns.AutoFit
xlsSheet.Cells(1, 1).Select
xlsName = xlsApp.GetSaveAsFilename(fileFilter:="Excel Files (*.xls), *.xls")
If xlsName <> False Then xlsBook.SaveAs FileName:=xlsName
xlsBook.Close
xlsApp.Quit
Set xlsSheet = Nothing
Set xlsBook = Nothing
Set xlsApp = Nothing
End Sub
Private Sub Class_Initialize()
Set CN = New Connection
Set RS = New Recordset
End Sub
Private Sub Class_Terminate()
Set CN = Nothing
Set RS = Nothing
End Sub