请看如下代码..生成了一个csv格式的文件后.在excel里导入就可以了..
Private Function csv(adors As ADODB.Recordset) As Boolean
    Dim iTotalRD As Integer
    Dim sExportfile As String
    Dim iFileNum As Integer
    Dim IfieldNumber As Integer
    Dim msg As String
    Dim iindex As Integer
    Screen.MousePointer = vbDefault
    On Error Resume Next
    With CommonDialog1
         .FileName = "Export.csv"
         .InitDir = App.Path
         .Filter = "Export Files(*.csv)|*.csv"
         .ShowSave
    End With
    Screen.MousePointer = vbHourglass
    iTotalRD = 0
    sExportfile = CommonDialog1.FileName
    iFileNum = FreeFile()
    Open sExportfile For Output As #iFileNum
    adors.MoveFirst
    Do Until adors.EOF
        iTotalRD = iTotalRD + 1
        For iindex = 0 To adors.Fields.Count - 1
             If (IsNull(adors.Fields(iindex))) Then
                Print #iFileNum, ",";
             Else
                If iindex = adors.Fields.Count - 1 Then
                    Print #iFileNum, Trim$(CStr(adors.Fields(iindex)));
                Else
                    Print #iflilnum, Trim$(CStr(adors.Fields(iindex))); ",";
                End If
             End If
        Next
        Print #iFileNum,
        adors.MoveNext
    Loop
    Close #iFileNum
    Screen.MousePointer = vbDefault
    csv = True
End Function