Vb中把.dat文件保存成execel,速度特別慢，那位高手能幫助解決一下，我今天必須解決啊！！求各位幫忙！！

Question

Vb中把.dat文件保存成execel,我的做法是把數據從.dat文件中讀出來，一條一條寫到ececel的單元格中，可是由於數據特別多（一共5000條），保存的時間大概需要2分半鍾！哪位高手有快速解決的辦法啊？我都要急死了！！希望大家幫幫忙！我聽説可以先導成.csv文件。再整體copy到execel,可是我不知道具體怎麽實現啊？

Answer 1

一條一條寫到ececel的單元格中，当然速度慢用CopyFromRecordset 方法Public Sub MSHFlexGrid2Excel(ctlFlexGrid As MSHFlexGrid, mode As Integer)
    On Error Resume Next
    
    Dim xlApp As New Excel.Application
    Dim xlWb As New Excel.Workbook
    Dim xlWs As New Excel.Worksheet
    
    Dim nRow As Integer
    Dim nCol As Integer
    
    Dim nRows As Integer
    Dim nCols As Integer
    
    nRows = ctlFlexGrid.Rows
    nCols = ctlFlexGrid.Cols
    
    'open Excel
    If mode = 1 Then
        'export to excel
        xlApp.Visible = True
    Else
        'print to printer via excel
        xlApp.Visible = False
    End If
    
    Set xlWb = xlApp.Workbooks.Add
    Set xlWs = xlApp.ActiveSheet
    
    'assign MSHFLexGrid into a recordset
    'don't forget to add MsADO in your Project/Reference
    Dim rs As ADODB.Recordset
    Set rs = ctlFlexGrid.DataSource  
    
    'fill the whole XL body at once, starting from cell A1
    xlWs.Cells(1, 1).CopyFromRecordset rs    'autofit the XL column    
    For nCol = 1 To nCols
        xlWs.Columns(nCol).AutoFit
    Next    'the actual printing    
    If mode = 2 Then 'to printer
        xlWs.PrintOut        xlApp.DisplayAlerts = False
        xlWb.Close (False)
        xlApp.Quit
    End If    'cleaning up
    Set xlApp = Nothing    
    Set rs = NothingEnd Sub

Answer 2

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

Answer 3

你可不可以加註釋啊？是不是數據已經存在一個文件中，在拷到.xls中啊？
我的文件是二進制的

Answer 4

你先导成.csv文件
从.csv文件导成excel就十分快了，用ado连接到csv，然后用CopyFromRecordset 方法

Answer 5

二進制的能查詢的嘛？我的程序里是把二進制文件中的數據全讀取到一個數組里，也就是說我現在要把這個]數組里的數據快速的寫到execel中！！

Answer 6

我就是不會到城.csv啊？你幫幫我啊！那個.csv是生成的嘛？然後從.csv到.xls是怎麽實現的啊？我也不會用ADO,也不會用你的那個方法啊！！求你幫幫忙！！

Answer 7

這個是原來的代碼！！你能幫我分析一下嘛？？謝謝！！
Private Sub Command2_Click(Index As Integer)
    Dim j            As Integer
    Dim strFName     As String
    Dim objXLS       As Object
    Dim STRDAT(4999) As Alrm
    Dim MODAT(4999)  As Alrm, MO
    Dim i            As Integer
    Dim DataCount   As Integer  'データ数格納
    Dim iRet        As Integer
    Dim cuWork      As Currency
    Dim TR_Save     As Integer
  
    On Error GoTo DiskErr
  
    Select Case Index
           
           Case 0
                '待ちメッセージの表示
'                If Existfloppy = False Then
'                   Form0005.Label1.Caption = ERR_ALARMDATA_MO_001
'                   Form0005.Label1.ForeColor = KRED
'                   Form0005.Show 1
'                   Exit Sub
'                 End If                
                  
               strFName = LLMODRIVER_SAVETREND & "履歴" & Format(Date, "yyyy") & "_" & Format(Date, "mm") & "_" & Format(Date, "dd") & ".xls"'               Set xlApp = CreateObject("Excel.Sheet.8")               'sheet名設定
'               xlApp.Worksheets(1).name = "全履歴データ"                '/** Excelをセット **/
                Set xlApp = Nothing
                Set xlApp = New Excel.Application
                If FileExists(FILE_MO) = True Then
                Else
                    '履歴保存が存在しません
                    Form0005.Label1.Caption = FILE_MO_NO_EXIST
                    Form0005.Label1.ForeColor = KRED
                    Form0005.Show 1
                    Exit Sub
            
                End If
                
                Call DispWaitMsg(True)
                
                '/** 印字フォーマットを選択しEXCELで起動 **/
                xlApp.Workbooks.Open FILE_MO
                
                'データ設定
                For i = 0 To DCount - 1
                     DoEvents
                     If gCancel = True Then
                        Exit For
                     End If
                     xlApp.Cells(i + 5, 1).Value = "'" & RTrim(DSPDAT(4999 - DCount + 1 + i).Data_Date)
                     xlApp.Cells(i + 5, 2).Value = "'" & RTrim(DSPDAT(4999 - DCount + 1 + i).Data_Time)
                     Select Case DSPDAT(4999 - DCount + 1 + i).Data_Gamen
                       
                        Case 1
                            xlApp.Cells(i + 5, 3).Value = "機器状態変化"
                        Case 2
                            xlApp.Cells(i + 5, 3).Value = "故障警報"
                        Case 3
                            xlApp.Cells(i + 5, 3).Value = "制御操作"
                        Case 4
                            xlApp.Cells(i + 5, 3).Value = "上下限YITUO"
                        Case 5
                            xlApp.Cells(i + 5, 3).Value = "設定値変更"
                        Case 6
                            xlApp.Cells(i + 5, 3).Value = "システム状態変化"
                     End Select
                     xlApp.Cells(i + 5, 4).Value = "'" & RTrim(DSPDAT(4999 - DCount + 1 + i).Data_Basyo)
                     xlApp.Cells(i + 5, 5).Value = "'" & RTrim(DSPDAT(4999 - DCount + 1 + i).Data_Mishou)
                     xlApp.Cells(i + 5, 6).Value = "'" & RTrim(DSPDAT(4999 - DCount + 1 + i).Data_HHLL)
                     xlApp.Cells(i + 5, 7).Value = "'" & RTrim(DSPDAT(4999 - DCount + 1 + i).Data_Teigi)
                     xlApp.Cells(i + 5, 8).Value = "'" & RTrim(DSPDAT(4999 - DCount + 1 + i).Data_Dousa)
                Next i                If gCancel = True Then
                   GetTaskList
                Else
                    ' EXCEL文档保存
                     xlApp.Workbooks(1).Saved = True
                     xlApp.Workbooks(1).SaveAs strFName
                     xlApp.Application.Quit
                     Set xlApp = Nothing
                End If
              
            Case 1
    End Select
    '終了
    Unload Me
   
    Exit Sub
DiskErr:
    If Err.Number = 1004 Then
        Form0005.Label1.Caption = ERR_ALARMDATA_MO_002
        Form0005.Label1.ForeColor = KRED
        Form0005.Label2.Caption = ERR_ALARMDATA_MO_003
        Form0005.Label2.ForeColor = KRED
        Form0005.Show 1
        Unload Form0007
    Else
        Form0005.Label1.Caption = ERR_ALARMDATA_MO_004
        Form0005.Label1.ForeColor = KRED
        Form0005.Show 1
        Unload Form0007
    End IfEnd Sub