VB把数据导出execl问题？

Question

怎样使导出的数据2000条为一个表，怎么写？

Answer 1

Private Sub ToExcle(rs As ADODB.RecordSet)
    Dim X As Object, xBook As Object, xSheet As Object, i%, j%
    Set X = CreateObject("excel.application") '创建EXCEL应用程序对象，启动EXCEL应用程序    j=0
NextFiel:
    Set xBook = X.Workbooks.Add              '新建一个工作簿，并将其赋给xbook
    Set xSheet = xBook.Worksheets(1)         '将xbook工作薄中的第一个表赋给xsheet
    X.Visible = False    
    
    rs.MoveFirst
    rs.Move j
    Do While Not rs.EOF 
        j=j+1
        For i = 0 To rs.Fields.Count-1
            xSheet.Cells(j, i+1)=rs.Feilds(i)          
        Next i
rs.MoveNext
If j mod 2000=0 Then 
    X.DisplayAlerts = False
         X.ActiveWorkbook.SaveAs App.Path & "test" & Int(j/2000) & ".xls"
    GoTo NextFile
End If
    Loop
    
    
    X.Quit                    '退出EXCEL
    Set xSheet = Nothing         '释放对象变量
    Set xBook = Nothing
    Set xls = Nothing
  Else
    MsgBox "没有可打印的记录！", vbInformation, "提示"
  End If
  
End Sub

Answer 2

怎样控制输出execl输出表格的大小？输出后表格大小总不合

Answer 3

Public Sub ExcelWidth()
  'On Error Resume Next
   Dim intColCnt As Integer
   Dim objFld As Field
    intColCnt = 1
    
    For Each objFld In PrintRst.Fields  'PrintRst為一數據集
        Select Case objFld.Type
            Case adGUID, adLongVarBinary, adLongVarWChar            Case Else
                objSheet.Columns(intColCnt).AutoFit
                intColCnt = intColCnt + 1
        End Select
    Next objFld
    Set objFld = Nothing
End Sub