导入数据到EXCEL中

Question

通过查询后，我的listbox中最多将有700条记录，请问，我如何在一按钮上编写程序，使得将listbox中的数据导入到EXCEL中。

Answer 1

给你一段把ListView中数据导入Excel中的代码.
Option ExplicitPrivate Const xlCenter = -4108
Private Const xlNone = -4142
Private Const xlContinuous = 1Private Const xlDiagonalDown = 5
Private Const xlDiagonalUp = 6
Private Const xlEdgeLeft = 7
Private Const xlEdgeTop = 8
Private Const xlEdgeBottom = 9
Private Const xlEdgeRight = 10
Private Const xlInsideVertical = 11
Private Const xlInsideHorizontal = 12Private Function CheckExcel() As Boolean
    Dim oExcel As Object
    
    On Error GoTo errHandle
    
    CheckExcel = False
    
    Set oExcel = CreateObject("Excel.Application")
    
    If Val(oExcel.Version) < 7 Then
        Err.Raise vbObjectError
    Else
        CheckExcel = True
    End If
    
    Set oExcel = Nothing
    Exit Function
errHandle:
    Set oExcel = Nothing
    Err.Clear
    MsgBox "请确认在本机已经安装了Microsoft Excel 97或以上版本", vbOKOnly + vbCritical, "系统提示"
End FunctionPublic Sub ListViewExportToExcel(lv As ListView, Optional ByVal psTitle As String, Optional ByVal pbShow As Boolean = True)
    Dim oExcel As Object
    Dim oSheet As Object
    Dim iRowCount As Integer
    Dim i As Integer, k As Integer
    
    If CheckExcel = False Then Exit Sub
    
    On Error GoTo errHandle
    
    Set oExcel = CreateObject("Excel.Application")
    Call oExcel.Workbooks.Add
    Set oSheet = oExcel.Sheets(1)
    
    If pbShow = True Then
        oExcel.Visible = True
    End If
    
    '生成标题
    iRowCount = 1
    If Trim(psTitle) <> "" Then
        oSheet.Cells(iRowCount, 1) = psTitle
    End If
    '合并居中
    With oSheet
        .Range(.Cells(iRowCount, 1), .Cells(iRowCount, lv.ColumnHeaders.Count)).Merge    '这儿要改报表的栏位数
        .Range(.Cells(iRowCount, 1), .Cells(iRowCount, 1)).HorizontalAlignment = xlCenter      '-4108
    End With
    
    '生成列标题
    iRowCount = iRowCount + 1
    For i = 1 To lv.ColumnHeaders.Count
        oSheet.Cells(iRowCount, i) = lv.ColumnHeaders.Item(i).Text
    Next i
    
    '画表格线
    If lv.ListItems.Count > 0 Then
        With oSheet.Range(oSheet.Cells(iRowCount, 1), oSheet.Cells(iRowCount + lv.ListItems.Count, lv.ColumnHeaders.Count)) '这儿要改报表的栏位数
            .Borders(xlDiagonalDown).LineStyle = xlNone     '-4142
            .Borders(xlDiagonalUp).LineStyle = xlNone
            .Borders(xlEdgeBottom).LineStyle = xlContinuous     '1
            .Borders(xlEdgeLeft).LineStyle = xlContinuous
            .Borders(xlEdgeRight).LineStyle = xlContinuous
            .Borders(xlEdgeTop).LineStyle = xlContinuous
            .Borders(xlInsideHorizontal).LineStyle = xlContinuous
            .Borders(xlInsideVertical).LineStyle = xlContinuous
        End With
    End If
    
    '生成内容
    iRowCount = iRowCount + 1
    For i = 1 To lv.ListItems.Count
        oSheet.Cells(iRowCount, 1) = lv.ListItems.Item(i).Text
        For k = 1 To lv.ColumnHeaders.Count - 1
            oSheet.Cells(iRowCount, k + 1) = lv.ListItems.Item(i).SubItems(k)
        Next k
        iRowCount = iRowCount + 1
    Next i
    
    '显示
    oExcel.Visible = True
    Set oExcel = Nothing
    
    Exit Sub
errHandle:
    oExcel.Visible = True
    Set oExcel = Nothing
    Call RaiseError("ClsExportToExcel.ListViewExportToExcel")
End Sub

Answer 2

不好意思，因为我从来没有写过这种导入的程序，所以不是很懂啊，能不能帮我写得详细一点
最好拿来就用，很急，用了再说，下次再好好的学一下
在这个listbox中，每一条记录形式是这样的“编号：1234567     姓名：张三”
我只需将以上内容导入进EXCEL就行了。谢谢大家了。

Answer 3

'請你自己加個CommonDialog控件
Private 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