不用控件
别人写的代码(借来学习):Private Function RsToExcel(ByVal Rs As Object, ByVal vFilename As String, ByRef lSumRecord As Long) As Long
'把记录集的内容保存到excel文件中
Dim oExcel As Excel.Application
Dim oBook As Excel.Workbook
Dim oSheet As Excel.Sheets
Dim j As Long, i As Long Set oExcel = CreateObject("Excel.Application")
Set oBook = oExcel.Workbooks.Add
Set oSheet = oBook.Worksheets(1)
'#########方法一######################
lSumRecord = 0
' On Error Resume Next
While Not Rs.EOF
j = j + 1
pgbRead.Value = j
For i = 0 To Rs.Fields.Count - 2
oSheet.Range(Trim(Chr(97 + i)) & CLng(j)) = Trim(Rs.Fields(i + 1))
DoEvents
Next
lSumRecord = lSumRecord + 1
Rs.MoveNext
DoEvents
Wend
pgbRead.Value = 1
'#########方法二#######################
' oSheet.Range("A").CopyFromRecordset Rs
If chkHavePassword.Value Then
oBook.SaveAs vFilename, , sRPassword, sWPassword
Else
oBook.SaveAs vFilename
End If
oExcel.Quit
Set oSheet = Nothing
Set oBook = Nothing
Set oExcel = Nothing
End Function
别人写的代码(借来学习):Private Function RsToExcel(ByVal Rs As Object, ByVal vFilename As String, ByRef lSumRecord As Long) As Long
'把记录集的内容保存到excel文件中
Dim oExcel As Excel.Application
Dim oBook As Excel.Workbook
Dim oSheet As Excel.Sheets
Dim j As Long, i As Long Set oExcel = CreateObject("Excel.Application")
Set oBook = oExcel.Workbooks.Add
Set oSheet = oBook.Worksheets(1)
'#########方法一######################
lSumRecord = 0
' On Error Resume Next
While Not Rs.EOF
j = j + 1
pgbRead.Value = j
For i = 0 To Rs.Fields.Count - 2
oSheet.Range(Trim(Chr(97 + i)) & CLng(j)) = Trim(Rs.Fields(i + 1))
DoEvents
Next
lSumRecord = lSumRecord + 1
Rs.MoveNext
DoEvents
Wend
pgbRead.Value = 1
'#########方法二#######################
' oSheet.Range("A").CopyFromRecordset Rs
If chkHavePassword.Value Then
oBook.SaveAs vFilename, , sRPassword, sWPassword
Else
oBook.SaveAs vFilename
End If
oExcel.Quit
Set oSheet = Nothing
Set oBook = Nothing
Set oExcel = Nothing
End Function
解决方案 »
免费领取超大流量手机卡,每月29元包185G流量+100分钟通话, 中国电信官方发货