On Error Resume Next
Dim irow, icol, count, i As Integer
Dim irowcount, icolcount As Integer
Dim xlApp As Excel.Application
Dim xlBook As Excel.Workbook
Dim xlSheet As Excel.Worksheet
Dim bl As Boolean
Dim key As Integer
Dim RsUserTemp As Recordset
Dim RsOrderTemp As Recordset
Dim a, b
Dim aa As String
aa = Trim(Now)
Set xlApp = CreateObject("excel.application")
Set xlBook = xlApp.Workbooks.Add
Set xlSheet = xlBook.Worksheets(1)
'If rs.RecordCount < 1 Then
'MsgBox ("Error 沒有記錄")
'Exit Sub
'End If
irowcount = rs.RecordCount
icolcount = 18
count = 0
rs.MoveFirst
For icol = 0 To 2
'xlSheet.Cells(1, 1).Value = "查詢數據" '加標頭；
Next icol
xlSheet.Cells(1, 1).Value = "時間" '加標頭；
xlSheet.Cells(1, 2).Value = "藥開度" '加標頭；
xlSheet.Cells(1, 3).Value = "藥瞬時流量" '加標頭；
xlSheet.Cells(1, 4).Value = "藥累計流量" '加標頭；
xlSheet.Cells(1, 5).Value = "礦漿濃度" '加標頭；
xlSheet.Cells(1, 6).Value = "礦漿流量" '加標頭
xlSheet.Cells(1, 7).Value = "酸1開度" '加標頭；
xlSheet.Cells(1, 8).Value = "酸1瞬時流量" '加標頭；
xlSheet.Cells(1, 9).Value = "酸1累計流量" '加標頭
xlSheet.Cells(1, 10).Value = "酸2開度" '加標頭；
xlSheet.Cells(1, 11).Value = "酸2瞬時流量" '加標頭；
xlSheet.Cells(1, 12).Value = "酸2累計流量" '加標頭
xlSheet.Cells(1, 13).Value = "酸3開度" '加標頭；
xlSheet.Cells(1, 14).Value = "酸3瞬時流量" '加標頭；
xlSheet.Cells(1, 15).Value = "酸3累計流量" '加標頭
xlSheet.Cells(1, 16).Value = "酸4開度" '加標頭；
xlSheet.Cells(1, 17).Value = "酸4瞬時流量" '加標頭；
xlSheet.Cells(1, 18).Value = "酸4累計流量"
xlSheet.Cells(1, 19).Value = "酸5開度"
xlSheet.Cells(1, 20).Value = "酸5瞬時流量"
xlSheet.Cells(1, 21).Value = "酸5累計流量"
Adodc1.Recordset.MoveFirst
For a = 2 To 200
b = 1
If Not Adodc1.Recordset.EOF Then
xlSheet.Cells(a, b) = Adodc1.Recordset("時間")
xlSheet.Cells(a, b + 1) = Adodc1.Recordset("藥開度")
xlSheet.Cells(a, b + 2) = Adodc1.Recordset("藥瞬時流量")
xlSheet.Cells(a, b + 3) = Adodc1.Recordset("藥累計流量")
xlSheet.Cells(a, b + 4) = Adodc1.Recordset("酸1開度")
xlSheet.Cells(a, b + 5) = Adodc1.Recordset("酸1瞬時流量")
xlSheet.Cells(a, b + 6) = Adodc1.Recordset("酸1累計流量")
xlSheet.Cells(a, b + 7) = Adodc1.Recordset("酸2開度")
xlSheet.Cells(a, b + 8) = Adodc1.Recordset("酸2瞬時流量")
xlSheet.Cells(a, b + 9) = Adodc1.Recordset("酸2累計流量")
xlSheet.Cells(a, b + 10) = Adodc1.Recordset("酸3開度")
xlSheet.Cells(a, b + 11) = Adodc1.Recordset("酸3瞬時流量")
xlSheet.Cells(a, b + 12) = Adodc1.Recordset("酸3累計流量")
xlSheet.Cells(a, b + 13) = Adodc1.Recordset("酸4開度")
xlSheet.Cells(a, b + 14) = Adodc1.Recordset("酸4瞬時流量")
xlSheet.Cells(a, b + 15) = Adodc1.Recordset("酸4累計流量")
xlSheet.Cells(a, b + 16) = Adodc1.Recordset("酸5開度")
xlSheet.Cells(a, b + 17) = Adodc1.Recordset("酸5瞬時流量")
xlSheet.Cells(a, b + 18) = Adodc1.Recordset("酸5累計流量")
Else
Exit For
End If
Adodc1.Recordset.Move 1
Next
rs.MoveFirst
xlSheet.Cells(2, 2).Value = Trim(Text1.Text) & Trim(Text2.Text)
For irow = 0 To irowcount - 1
Set RsUserTemp = New Recordset
RsUserTemp.CursorLocation = adUseClient
RsUserTemp.Open "select * from 狀態數據 " _
& "where user0_id=" & rs!user0_id, Cn, adOpenStatic, adLockReadOnly
xlSheet.Cells(irow + 4, 1).Value = count + 1
xlSheet.Cells(irow + 4, 2).Value = RsUserTemp!user0_id
xlSheet.Cells(irow + 4, 3).Value = RsUserTemp!user0_name
xlSheet.Cells(irow + 4, 4).Value = RsUserTemp!Address
xlSheet.Cells(irow + 4, 5).Value = RsUserTemp!callno1
Set RsUserTemp = Nothing
Set RsOrderTemp = New Recordset
RsOrderTemp.CursorLocation = adUseClient
RsOrderTemp.Open "select * from 狀態數據 where user0_id = " _
If RsOrderTemp.RecordCount = 0 Then
Else
RsOrderTemp.MoveFirst
Do While (Not RsOrderTemp.EOF)
key = 0
key = Val(Mid(str(RsOrderTemp!Order_Time), 6, 2))
Select Case key
Case 0
Exit Do
Case 1
xlSheet.Cells(irow + 4, 6).Value = RsOrderTemp!Order_Amount
Case 2
xlSheet.Cells(irow + 4, 7).Value = RsOrderTemp!Order_Amount
Case 3
xlSheet.Cells(irow + 4, 8).Value = RsOrderTemp!Order_Amount
Case 4
xlSheet.Cells(irow + 4, 9).Value = RsOrderTemp!Order_Amount
Case 5
xlSheet.Cells(irow + 4, 10).Value = RsOrderTemp!Order_Amount
Case 6
xlSheet.Cells(irow + 4, 11).Value = RsOrderTemp!Order_Amount
Case 7
xlSheet.Cells(irow + 4, 12).Value = RsOrderTemp!Order_Amount
Case 8
xlSheet.Cells(irow + 4, 13).Value = RsOrderTemp!Order_Amount
Case 9
xlSheet.Cells(irow + 4, 14).Value = RsOrderTemp!Order_Amount
Case 10
xlSheet.Cells(irow + 4, 15).Value = RsOrderTemp!Order_Amount
Case 11
xlSheet.Cells(irow + 4, 16).Value = RsOrderTemp!Order_Amount
Case 12
xlSheet.Cells(irow + 4, 17).Value = RsOrderTemp!Order_Amount
End Select
RsOrderTemp.MoveNext
Loop
End If
Set RsOrderTemp = Nothing
count = count + 1
rs.MoveNext
If bl Then '因為第壹條記錄還未導出所以讓指針回滾；
rs.MovePrevious
End If
Next
xlApp.Visible = True
xlBook.Save
Set xlApp = Nothing
End Sub
這是我的壹個代碼，參考壹下吧。。。導出到EXCEL的 '百度Hi群&飛度編程學社 1195277