可不可以把access 的数据直接写到excel的listview中

yanrsamura

Private Sub lblFindNow_Click() Dim itmX As ListItem

Dim CNN As New ADODB.Connection

Dim RST As New ADODB.Recordset

Dim Stpath, strSQL As String

Dim StartDate As String, EndDate As String, Dwmc As String

Stpath = ThisWorkbook.Path & Application.PathSeparator & "採購訂單數據庫.mdb"

CNN.Open "provider=Microsoft.jet.OLEDB.4.0;data source=" & Stpath

If Sheet1.TXT1.Value = "" Then

MsgBox "沒有搜索的字符串", vbInformation, "信息"

Exit Sub

End If

StartDate = Worksheets(1).TXT3.Value: EndDate = Worksheets(1).TXT4.Value: Dwmc = Worksheets(1).TXT1.Value

strSQL = "Select 貨號,貨名,PO,數量,貨期 from 數據庫1 "

strSQL = strSQL & "Where 貨號 = '" & Dwmc & "'"

strSQL = strSQL & " Order By 貨期 "

On Error Resume Next

RST.Open strSQL, CNN, adOpenDynamic

'Worksheets("sheet3").Range("A5:K10000").ClearContents

'Worksheets("sheet3").Cells(5, 1).CopyFromRecordset RST

后面的代码要怎样写？recordest 中有多条记录，我想直接全部写到listview中去，但下面的代码只能写入一个记录，如果用 do ----loop 则死循环。

我对 DAO和SQL不是很熟，请大家帮帮我

RST.MoveFirst

Set itmX = Worksheets("sheet1").ListView1.ListItems.Add( )

' Do While Not RST.EOF

itmX.SubItems(1) = RST.Fields(1)

itmX.SubItems(2) = RST.Fields(2)

itmX.SubItems(3) = RST.Fields(3)

itmX.SubItems(4) = RST.Fields(4)

'Loop

RST.Close

CNN.Close

End Sub

[此贴子已经被作者于2005-7-15 19:18:17编辑过]

wan_shan

以下是引用yanrsamura在2005-7-15 18:48:15的发言： 可不可以把access 的数据直接写到excel的listview中.....

这里的例子中有一个可以把数据导入到指定的工作表，你也许可以参考一下：http://www.accfans.net/dvbbs/dispbbs.asp?BoardID=26&ID=8188

[此贴子已经被作者于2005-7-15 23:12:25编辑过]

中国深圳

前几天帮本论坛的会员写了一个软件，因报表要求太高只能把数据输出到EXCEL 中，特写了如下代码。现贴出来供你参考，如还搞不定再继续讨论。

Private Sub Command0_Click() Dim rs As ADODB.Recordset Dim I As Integer Dim xlApp As Excel.Application Dim xlBook As Workbook, xlSheet As Worksheet

Set rs = New ADODB.Recordset

Set xlApp = CreateObject("Excel.Application") Set xlApp = New Excel.Application Set xlBook = xlApp.Workbooks.Open(CurrentProject.Path & "\acc.XLS") '打开要输出的EXECL文件 Set xlSheet = xlBook.Worksheets(1) '打开工作表,这里是第一个,可以设其他 xlApp.Visible = True '显示

rs.Open "TBL_现金日报表", CurrentProject.Connection, 3, 3

If Not rs.EOF Then rs.MoveFirst

Do While Not rs.EOF I = I + 1 For x = 0 To 2

xlSheet.Cells(I, x + 1) = rs(x) 'CELLS(行,列) 单元格 Next x rs.MoveNext Loop rs.Close 'xlSheet.PrintPreview '如果是要打印，只要把 PrintPreview 改为 PrintOut 'xlBook.Close SaveChanges:=False 'xlApp.Quit '退出

End Sub

yanrsamura

谢谢两位的指点，我去研究一下。

yanrsamura

呵呵，加个 rst.movenext 就行了。