下面的代码,单步执行到红色标记地方就没反应了,SQL语句在查询分析器中是可以正常运行的
Private Sub Command1_Click()
Dim cn As New ADODB.Connection
Dim rs As New ADODB.Recordset
Dim strsql As String
On Error Resume Next
cn.CursorLocation = adUseClient
cn.Open "Provider=SQLOLEDB.1;Data Source=127.0.0.1;UID=sa;PWD=sa;initialcatalog=STCard_Enp;ConnectionTimeout= 0"
strsql = "select Dept_Name,Person_Name,Brush_Date,Brush_Time,bz from (select s.Card_No,s.Dept_Name,s.Person_Name,s.Brush_Date,isnull(t.Brush_Time,'')Brush_Time from  " & _
"(select Card_No,Dept_Name,Person_Name,Brush_Date from " & _
"(select distinct a.Card_No,Dept_Name,Person_Name from ST_Person a,ST_Department b,KQ_Download g where a.Dept_ID=b.Dept_ID and a.Card_No=g.Card_No and Dept_Name='" & Combo1.Text & " ') s,(select dateadd(day,number,'" & Text1.Text & " ')Brush_Date from master..spt_values where type='P' and dateadd(day,number,'" & Text1.Text & " ')<='" & Text2.Text & " ') t) s  " & _
"left join (select distinct Card_No,Brush_Date, dbo.f_hb(Card_No,Brush_Date) as Brush_time  from KQ_Download d " & _
"where not exists (select 1 from KQ_SJ where Card_id=d.Card_No and date1=d.Brush_Date and d.Brush_Time between time1 and time2 ) and  Brush_Date between '" & Text1.Text & " ' and '" & Text2.Text & " ') t on s.Card_No=t.Card_No and s.Brush_Date=t.Brush_Date ) as h " & _
"left join kq_Sj on h.Card_No=Card_ID and date1=h.Brush_date " & _
"order by Dept_Name,Person_Name,h.Brush_Date"
rs.Open strsql, cn, adOpenKeyset, adLockReadOnlyIf rs.RecordCount = 0 Then
    MsgBox "没有适合条件的记录"
Exit Sub
End If
VSFlexGrid1.Rows = rs.RecordCount + 1
i = 1
Do While rs.EOF = False
    VSFlexGrid1.TextMatrix(i, 0) = rs.Fields("Dept_Name")
    VSFlexGrid1.TextMatrix(i, 1) = rs.Fields("Person_Name")
    VSFlexGrid1.TextMatrix(i, 2) = rs.Fields("Brush_Date")
If IsNull(rs.Fields("Brush_time")) Then
  VSFlexGrid1.TextMatrix(i, 3) = 0
Else
 VSFlexGrid1.TextMatrix(i, 3) = rs.Fields("Brush_time")
End If

解决方案 »

  1.   

    本帖最后由 bcrun 于 2011-01-04 10:39:32 编辑
      

  2.   

    cn.Open "Provider=SQLOLEDB.1;Data Source=127.0.0.1;UID=sa;PWD=sa;initialcatalog=STCard_Enp;ConnectionTimeout=1000"
      

  3.   


    Private Sub Command1_Click()
    Dim cn As New ADODB.Connection
    Dim rs As New ADODB.Recordset
    Dim strsql As String
    On Error Resume Next
    set rs=new adodb.recordset
    cn.CursorLocation = adUseClient
    cn.Open "Provider=SQLOLEDB.1;Data Source=127.0.0.1;UID=sa;PWD=sa;initialcatalog=STCard_Enp;ConnectionTimeout= 0"
    strsql = "select Dept_Name,Person_Name,Brush_Date,Brush_Time,bz from (select s.Card_No,s.Dept_Name,s.Person_Name,s.Brush_Date,isnull(t.Brush_Time,'')Brush_Time from " & _
    "(select Card_No,Dept_Name,Person_Name,Brush_Date from " & _
    "(select distinct a.Card_No,Dept_Name,Person_Name from ST_Person a,ST_Department b,KQ_Download g where a.Dept_ID=b.Dept_ID and a.Card_No=g.Card_No and Dept_Name='" & Combo1.Text & " ') s,(select dateadd(day,number,'" & Text1.Text & " ')Brush_Date from master..spt_values where type='P' and dateadd(day,number,'" & Text1.Text & " ')<='" & Text2.Text & " ') t) s " & _
    "left join (select distinct Card_No,Brush_Date, dbo.f_hb(Card_No,Brush_Date) as Brush_time from KQ_Download d " & _
    "where not exists (select 1 from KQ_SJ where Card_id=d.Card_No and date1=d.Brush_Date and d.Brush_Time between time1 and time2 ) and Brush_Date between '" & Text1.Text & " ' and '" & Text2.Text & " ') t on s.Card_No=t.Card_No and s.Brush_Date=t.Brush_Date ) as h " & _
    "left join kq_Sj on h.Card_No=Card_ID and date1=h.Brush_date " & _
    "order by Dept_Name,Person_Name,h.Brush_Date"
    rs.Open strsql, cn, 1,3
    If rs.RecordCount = 0 Then
      MsgBox "没有适合条件的记录"
    Exit Sub
    End If
    VSFlexGrid1.Rows = rs.RecordCount + 1
    i = 1
    Do While rs.EOF = False
      VSFlexGrid1.TextMatrix(i, 0) = rs.Fields("Dept_Name")
      VSFlexGrid1.TextMatrix(i, 1) = rs.Fields("Person_Name")
      VSFlexGrid1.TextMatrix(i, 2) = rs.Fields("Brush_Date")
    If IsNull(rs.Fields("Brush_time")) Then
      VSFlexGrid1.TextMatrix(i, 3) = 0
    Else
     VSFlexGrid1.TextMatrix(i, 3) = rs.Fields("Brush_time")
    End If