高手请进，如何将数据表或者查询内容导入到一个excel文件中？

[thankyourfish]

我现在要将一个数据表或者查询内容导入到一个excel文件中，请高手指点，有什么好的例子！thanks a lot !

[gzqg]

所有任务->导出数据 选择Excel
或者直接用代码写

[thankyourfish]

谢谢楼上！我全部用的ADO，而且是用代码连接，你能讲详细些吗？是在哪导出数据呢？

[winhyf]

Dim conn As New ADODB.Connection
Dim rs As New ADODB.Recordset
Dim myexcel As New Excel.Application, i, j, k As Integer, col As String

.......

sub()
On Error GoTo eee
.Application.Visible = False
.Workbooks.Add
j = 0
For i = 65 To (65 + rs.Fields.Count - 1)
col = Chr(i) & "1"
Range(col).Select
ActiveCell.FormulaR1C1 = rs.Fields(j).Name '
j = j + 1
Next i
k = 0
rs.MoveFirst
DoEvents
For j = 2 To 2 + rs.RecordCount
k = 0
For i = 65 To (65 + rs.Fields.Count - 1)
col = Chr(i) & CStr(j)
Range(col).Select
ActiveCell.FormulaR1C1 = rs.Fields(k)
k = k + 1
Next i
On Error Resume Next
rs.MoveNext
If rs.EOF = True Then
.Application.Visible = True
End If
Next j
End With
Exit Sub
eee:
MsgBox ("错误")

End Sub

[winhyf]

Dim conn As New ADODB.Connection
Dim rs As New ADODB.Recordset
Dim myexcel As New Excel.Application, i, j, k As Integer, col As String

.......

sub()
With myexcel
On Error GoTo eee
.Application.Visible = False
.Workbooks.Add
j = 0
For i = 65 To (65 + rs.Fields.Count - 1)
col = Chr(i) & "1"
Range(col).Select
ActiveCell.FormulaR1C1 = rs.Fields(j).Name '
j = j + 1
Next i
k = 0
rs.MoveFirst
DoEvents
For j = 2 To 2 + rs.RecordCount
k = 0
For i = 65 To (65 + rs.Fields.Count - 1)
col = Chr(i) & CStr(j)
Range(col).Select
ActiveCell.FormulaR1C1 = rs.Fields(k)
k = k + 1
Next i
On Error Resume Next
rs.MoveNext
If rs.EOF = True Then
.Application.Visible = True
End If
Next j
End With
Exit Sub
eee:
MsgBox ("错误")

End Sub

[lyz803]

这是我给我以前的一个用户的!很少,不过十分的容易理解,你看看!!



Dim MyExcel As New Excel.Application
Dim WithEvents MyBook As Excel.Workbook
Private Sub Command1_Click()
'MyExcel.Name = "报表试验程序"
'MyExcel.Quit


Dim i As Integer
Dim Cn As New ADODB.Connection
Dim Rs As New ADODB.Recordset
Cn.ConnectionString = "PROVIDER=sqloledb;server=192.168.0.17;uid=sa;pwd=123;database=saron"
Cn.Open
Rs.Open "select * from yh", Cn, adOpenDynamic, adLockPessimistic
Set MyBook = GetObject(App.Path & "\123.xls")
MyBook.Application.Visible = True
MyBook.Windows(1).Visible = True

Dim j As Integer
j = 1
i = 1
Do While Not Rs.EOF
i = i + 1
'If i >= 1000 Then
' j = j + 1
' i = 0
'End If
MyBook.Worksheets(j).Range("A" & i).Value = Rs.Fields(0)
MyBook.Worksheets(j).Range("B" & i).Value = Rs.Fields(1)
MyBook.Worksheets(j).Range("C" & i).Value = Rs.Fields(2)
MyBook.Worksheets(j).Range("D" & i).Value = Rs.Fields(3)
Rs.MoveNext
DoEvents
'Timer1
Loop
MyBook.Save
MyBook.Close
MsgBox "数据转入完全，请关闭本程序"
End Sub
Public Sub Timer1()
Dim s As Single
s = Timer
Do While Timer - s <= 0.5
Loop
End Sub
Private Sub Form_Load() '
Timer1
'Dim ArrTemp(1 To 7)
'Dim i As Integer
'For i = 1 To 7
' ArrTemp(i) = MyBook.Worksheets(1).Range("A" & i).Value
'Next
'MyBook.Worksheets(1).Range("C3").Value = "2000"
'MyBook.Worksheets(1).Range("A1").Value = "姓名"
'MyBook.Worksheets(1).Range("B1").Value = "卡号"
'MyBook.Worksheets(1).Range("C1").Value = "住址"
'MyBook.Worksheets(1).Range("D1").Value = "单位"
'MyBook.Worksheets(1).Range("E1").Value = "通气日期"
'MyBook.Worksheets(1).Range("F1").Value = "备注"


End Sub