vb导出数据到EXCEL的问题

Question

我原来用office xp，一切正常。但现在换成office2000后，发现记录集中文本的字段多了许多空格出来，不知道如何去掉。
我用这种办法导出数据到excel2000中
    Set ExcelQuery = ExcelWS.QueryTables.Add(rst, ExcelWS.Range("a1"))

Answer 1

自已加個控件commondialogPrivate Sub Command3_Click()
    Dim objFileSystem As Object
    Dim objExcelText As Object
    Dim strTableString As String, i As Integer, strFileName As String
    Dim pubConn As New ADODB.Connection
    Dim rsTable As New ADODB.Recordset
    Dim strConn As String
    Dim strSQL As String    strConn = "Provider=SQLOLEDB.1;Persist Security Info=False;User ID=develop; password=12345;Data Source=ServerNmae"
    pubConn.Open strConn
    rsTable.CursorLocation = adUseClient
    strSQL = "select top 10 * from gate_register"
    rsTable.Open strSQL, pubConn, adOpenDynamic, adLockOptimistic
    
    For i = 0 To rsTable.Fields.Count - 1
        strTableString = strTableString & rsTable.Fields(i).Name & Chr(9)  '獲取字段名
    Next
    strTableString = strTableString & rsTable.GetString     '字段名+數據庫的記錄
    
    cmDialog.CancelError = False
    cmDialog.FileName = "FileName"  '默認生成的文件名
    cmDialog.DialogTitle = "Save Export File"
    cmDialog.Filter = "Excel (*.xls)|*.xls|文本文件(*.DBF)|*.DBF|檔案文件(*.doc)|*.doc|所有文件(*.*)|*.*"
    cmDialog.DefaultExt = "*.xls"
    cmDialog.ShowSave
    strFileName = cmDialog.FileName
    
    Set objFileSystem = CreateObject("Scripting.FileSystemObject")
    Set objExcelText = objFileSystem.createtextfile(strFileName, True)
    objExcelText.writeline (strTableString)
    
    objExcelText.Close
    Set objFileSystem = Nothing
End Sub

Answer 2

我知道有一段宏可以实现这个功能，但是我不知道怎么写入vb代码中。
    For Each cell In ExcelWS.Range("a1")
        cell.Value = Trim(cell.Value)
    Next

Answer 3

Dim xlApp As New Excel.Application
        Dim xlBook As Excel.Workbook
        Dim xlSheet As Excel.Worksheet
        
        Dim a As Excel.CellFormat
        
        Screen.MousePointer = 11        Set xlApp = CreateObject("Excel.Application")
        Set xlBook = Nothing
        Set xlSheet = Nothing
        Set xlBook = xlApp.Workbooks().Add
        Set xlSheet = xlBook.Worksheets("sheet1")
        xlApp.Visible = True
          i = 0
        For i = 0 To MSFlexGrid1.Rows - 1
            For j = 1 To 20
                 xlSheet.Cells(i + 1, j).Value = MSFlexGrid1.TextMatrix(i, j)
            Next j
        Next i
        xlApp.Application.Visible = True
        Set xlApp = Nothing  '"交还控制给Excel
        Set xlBook = Nothing
        Set xlSheet = Nothing
        Screen.MousePointer = 0  ' 恢复鼠标指针
这是ＭＳＦＬＥＸＧＲＩＤ导出到ＥＸＣＥＬ的例子，自已把它改成记录集的就可以了

Answer 4

参考
http://www.microsoft.com/china/community/Column/32.mspx

Answer 5

Option Explicit
   Public myExcle As New Excel.Application
   Public myBook As New Excel.Workbook
   Public mySheet As New Excel.WorksheetPrivate Sub Command1_Click()
   Dim conn As New ADODB.Connection
   Dim rs As ADODB.Recordset
   conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\db1.mdb" & ";Persist Security Info=False"
   conn.CursorLocation = adUseClient
   Set rs = conn.Execute("YourTable", , adCmdTable)   'Create a new workbook in Excel   Set myExcle = CreateObject("Excel.Application")
   Set myBook = myExcle.Workbooks.Add
   Set mySheet = myBook.Worksheets(1)
   
   'Transfer the data to Excel
   mySheet.Range("A1").CopyFromRecordset rs   mySheet.Columns(1).ColumnWidth = 15
   mySheet.Columns(2).ColumnWidth = 15
   mySheet.Columns(3).ColumnWidth = 15
   mySheet.Columns(4).ColumnWidth = 15
   
   '设置整列样式
   mySheet.Columns(1).NumberFormatLocal = "00"   '整数
   mySheet.Columns(2).NumberFormatLocal = "@"    '文本
   mySheet.Columns(3).NumberFormatLocal = "￥0.00"  '小数
   mySheet.Columns(4).NumberFormatLocal = "yyyy年mm月dd日"   '日期
   
   mySheet.Rows(1).Insert (1)
   mySheet.Cells.HorizontalAlignment = xlCenter
   mySheet.Cells.VerticalAlignment = xlCenter
   mySheet.Cells(1, 1) = "自动ID"
   mySheet.Cells(1, 2) = "名称"
   mySheet.Cells(1, 3) = "数量"
   mySheet.Cells(1, 4) = "日期"   'Save the Workbook and Quit Excel
   myBook.SaveAs App.Path & "\Book1.xls"
   myExcle.Quit   'Close the connection
   rs.Close
   conn.CloseEnd Sub

Answer 6

cmd.commandtext="insert into [Excel文件].[Sheet1$] select * from ..."
cmd.execute

Answer 7

'这样是不用生成任何文件的，也很方便赋值
    Dim vbExcel As New Excel.Application
    vbExcel.Workbooks.Open sSourceFile, False, False
    vbExcel.Visible = False
    vbExcel.DisplayAlerts = False
    vbExcel.AlertBeforeOverwriting = False
    vbExcel.Cells(i, j)='你要给的值'
    ....
    vbExcel.Quit
    Set vbExcel = Nothing
    

Answer 8

'窗体上放一个CommonDialog、CommandButton
Private Sub Command3_Click()
    Dim pubConn As New ADODB.Connection
    Dim rsTable As New ADODB.Recordset
    Dim strConn As String
    Dim strSQL As String
    Dim AppExcel As Excel.Application: Dim BookExcel As Excel.Workbook
    Dim ExcelFileName As String
    
    On Error Resume Next
    
    With cmDialog
        .Filter = "Excel|*.xls"
        .DialogTitle = "建立输出文件"
        .ShowSave
        If Err Then Exit Sub
        ExcelFileName = .FileName
    End With
    
    strConn = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\db1.mdb" & ";Persist Security Info=False"
    pubConn.Open strConn
    rsTable.CursorLocation = adUseClient
    strSQL = "select top * from Table1"
    rsTable.Open strSQL, pubConn, adOpenStatic, adLockOptimistic
    
    Set AppExcel = CreateObject("Excel.Application")
    If Dir$(ExcelFileName) = "" Then
        Set AppExcel = New Excel.Application
        AppExcel.Visible = False
        Set BookExcel = AppExcel.Workbooks.Add
        AppExcel.Worksheets(1).Range("A1").CopyFromRecordset rsTable
        BookExcel.SaveAs (ExcelFileName)
    Else
        Set BookExcel = AppExcel.Workbooks.Open(ExcelFileName)
        AppExcel.Worksheets(1).Range("A1").CopyFromRecordset rsTable
        BookExcel.Save
    End If
    
    AppExcel.Quit
    BookExcel.Close
    Set BookExcel = Nothing
    Set AppExcel = Nothing
    rsTable.Close
    Set rsTable = Nothing
    pubConn.Close
    Set pubConn = Nothing
    
    MsgBox "保存完成"End Sub