无源recordset的操作

Question

Dim rsMedia As New ADODB.Recordset '定义rsMedia 为窗体模块级变量
Private Sub Form_Load()
          DTPicker1.Value = CStr(Date)
          On Error Resume Next   '因为一开始的时候rsMedia.EOF 或BOF 都为true，所以加了这句
          rsMedia.Fields.Append "条形码", adVariant, , adFldMayBeNull + adFldIsNullable + adFldUpdatable
          rsMedia.Fields.Append "商品类别", adVariant, , adFldMayBeNull + adFldIsNullable + adFldUpdatable
          rsMedia.Fields.Append "商品名称", adVariant, , adFldMayBeNull + adFldIsNullable + adFldUpdatable
          rsMedia.Fields.Append "销售单价", adVariant, , adFldMayBeNull + adFldIsNullable + adFldUpdatable
          rsMedia.Fields.Append "销售数量", adVariant, , adFldMayBeNull + adFldIsNullable + adFldUpdatable
          rsMedia.Fields.Append "销售金额", adVariant, , adFldMayBeNull + adFldIsNullable + adFldUpdatable
          rsMedia.Fields.Append "销售时间", adVariant, , adFldMayBeNull + adFldIsNullable + adFldUpdatable
          rsMedia.Fields.Append "退货时间", adVariant, , adFldMayBeNull + adFldIsNullable + adFldUpdatable
          rsMedia.Fields.Append "是否归还货架", adVariant, , adFldMayBeNull + adFldIsNullable + adFldUpdatable
          rsMedia.Open
  ' rsMedia.AddNew
End Sub
接下来查询按钮单击事件，就用text1.text 和dtpicker1的时间来查询数据库,然后将查询到的所有记录都addnew到rsMedia recordset中,DataGrid1就以rsMedia 为数据源了
Private Sub Command1_Click()
    Dim dateCheck1, dateCheck2 As Date
    dateCheck1 = CDate(DTPicker1.Value & " 00:00:00")
    dateCheck2 = CDate(DTPicker1.Value & " 23:59:59")
    a$ = Trim(Text1)
    If a$ = "" Then
        MsgBox "请输入条形码", 0, "华庭销售"
        Text1.Text = ""
        Text1.SetFocus
        Exit Sub
    End If
    strSQL$ = "select * from FinishedDeal where number='" & a$ & "' and dealDate between #" & dateCheck1 & "# and #" & dateCheck2 & "# order by dealDate desc"
    Dim connQuery As New ADODB.Connection
    connQuery.CursorLocation = adUseClient
    Dim rsQuery As New ADODB.Recordset
    Call PubConnSub(connQuery, rsQuery, strSQL$, 2, 1)
    If rsQuery.EOF Then
          MsgBox DTPicker1.Value & "这天没有出售过[条形码]为" & a$ & "的商品", 0, "华庭销售"
          rsQuery.Close
          Set rsQuery = Nothing
          connQuery.Close
          Set connQuery = Nothing
    Else
          rsMedia.AddNew
          While Not rsQuery.EOF
              For j = 1 To rsQuery.Fields.Count - 1 '因为rsQuery（1）到rsQuery（rsQuery.Fields.Count - 1 ）都是相同的数据字段
                    rsMedia(j - 1) = rsQuery(j)
              Next j
              rsMedia(7) = Now
              If Check1.Value Then
                   rsMedia(8) = True
              Else
                  rsMedia(8) = False
              End If
              rsQuery.MoveNext
              '这里缺少rsMedia.MoveNext吗？
          Wend
          rsMedia.updatebatch
          Set DataGrid1.DataSource = rsMedia
          DataGrid1.Refresh
    End If
End Sub              For j = 1 To rsQuery.Fields.Count - 1 '因为rsQuery（1）到rsQuery（rsQuery.Fields.Count - 1 ）都是相同的数据字段
                    rsMedia(j - 1) = rsQuery(j)
              Next j问题好象就出现在这里，已经仔细检查过字段结构，没发现错误，请数据库操作高手指教一下

Answer 1

说明一下Call PubConnSub(connQuery, rsQuery, strSQL$, 2, 1)这个是访问数据库的通用过程，没错的，因为其他很多窗体中的访问都没错

Answer 2

是不是没有错误提示，但是DataGrid却不显示数据？如果是那样，你设置一下rsMedia的游标：Dim rsMedia As New ADODB.Recordset '定义rsMedia 为窗体模块级变量
Private Sub Form_Load()
    DTPicker1.Value = CStr(Date)
    On Error Resume Next   '因为一开始的时候rsMedia.EOF 或BOF 都为true，所以加了这句
    ......
    rsMedia.CursorLocation=adUseClient
 
    rsMedia.Open
  ' rsMedia.AddNew
End Sub

Answer 3

我也找不出什么错误来,但是datagrid中显示#Error

Answer 4

运行没有出错，但是rsMedia和rsQuery对应的字段就在datagrid中显示#ERROR,而
 rsMedia(7) = Now
If Check1.Value Then
rsMedia(8) = True
Else
rsMedia(8) = False
End If
这里的效果就出来了,加上 rsMedia.CursorLocation=adUseClient这个后也不行还是看到#ERROR

Answer 5

Dim rsMedia As New ADODB.Recordset
Private Sub Form_Load()
          DTPicker1.Value = CStr(Date)
          'On Error Resume Next
          rsMedia.Fields.Append "条形码", adVariant, , adFldMayBeNull + adFldIsNullable + adFldUpdatable
          rsMedia.Fields.Append "商品类别", adVariant, , adFldMayBeNull + adFldIsNullable + adFldUpdatable
          rsMedia.Fields.Append "商品名称", adVariant, , adFldMayBeNull + adFldIsNullable + adFldUpdatable
          rsMedia.Fields.Append "销售单价", adVariant, , adFldMayBeNull + adFldIsNullable + adFldUpdatable
          rsMedia.Fields.Append "销售数量", adVariant, , adFldMayBeNull + adFldIsNullable + adFldUpdatable
          rsMedia.Fields.Append "销售金额", adVariant, , adFldMayBeNull + adFldIsNullable + adFldUpdatable
          rsMedia.Fields.Append "销售时间", adVariant, , adFldMayBeNull + adFldIsNullable + adFldUpdatable
          rsMedia.Fields.Append "退货时间", adVariant, , adFldMayBeNull + adFldIsNullable + adFldUpdatable
          rsMedia.Fields.Append "是否归还货架", adVariant, , adFldMayBeNull + adFldIsNullable + adFldUpdatable
         ' rsMedia.CursorLocation = 0
          rsMedia.Open
End SubPrivate Sub Command1_Click()
    Dim dateCheck1, dateCheck2 As Date
    dateCheck1 = CDate(DTPicker1.Value & " 00:00:00")
    dateCheck2 = CDate(DTPicker1.Value & " 23:59:59")
    a$ = Trim(Text1)
    If a$ = "" Then
        MsgBox "请输入条形码", 0, "华庭销售"
        Text1.Text = ""
        Text1.SetFocus
        Exit Sub
    End If
    strSQL$ = "select * from FinishedDEal where number='" & a$ & "' and dealDate between #" & dateCheck1 & "# and #" & dateCheck2 & "# order by dealDate"
    Dim connQuery As New ADODB.Connection
    connQuery.CursorLocation = adUseClient
    Dim rsQuery As New ADODB.Recordset
    Call PubConnSub(connQuery, rsQuery, strSQL$, 3, 3)
    If rsQuery.EOF Then
          MsgBox DTPicker1.Value & "这天没有出售过[*条形码*]为" & a$ & "的商品", 0, "华庭销售"
          rsQuery.Close
          Set rsQuery = Nothing
          connQuery.Close
          Set connQuery = Nothing
    Else
          rsQuery.MoveFirst
          While Not rsQuery.EOF
              rsMedia.AddNew
              For j = 0 To 4
                    rsMedia(j) = rsQuery(j + 1)
              Next j
              rsMedia(5) = rsQuery(7)
              rsMedia(6) = rsQuery(8)
              rsMedia(7) = Now
              If Check1.Value Then
                   rsMedia(8) = True
              Else
                  rsMedia(8) = False
              End If
              'rsMedia.Update
              rsQuery.MoveNext
             ' rsMedia.MoveNext
          Wend
          rsMedia.UpdateBatch
          Set DataGrid1.DataSource = rsMedia
          DataGrid1.Refresh
    End If
End Sub运行没报错，但是datagrid上显示出"#ERROR", 
              rsMedia(7) = Now
              If Check1.Value Then
                   rsMedia(8) = True
              Else
                  rsMedia(8) = False
              End If
这两个字段就addnew成功并在datagrid中显示出来，郁闷得很啊，整个晚上都没有弄出来
请星光闪闪的高手出来指点一下迷津啊