Recordset sang Excel VB6 (không vòng lặp)

ta phải chèn thư viện ADO trước, nếu không sẽ báo lỗi.

Private Sub Recorset2Excel(ByVal Re As Recordset, Fpath As String)

Dim zExcel As Object: Set zExcel = CreateObject("Excel.Application")

Dim zBook As Object: Set zBook = zExcel.Workbooks.Add

Dim NRow&: NRow = rs.RecordCount

Dim NCol&: NCol = rs.Fields.Count ' Created by truongphu

Clipboard.Clear

Dim MM$, i&

For i = 0 To NCol - 1 ' ghi tên môi côt

   If i < NCol - 1 Then

        MM = MM & Re.Fields(i).Name & vbTab

    Else

        MM = MM & Re.Fields(i).Name & vbCrLf

    End If

Next

Clipboard.SetText MM & Re.GetString(2, , , vbCrLf)

zBook.Worksheets(1).Paste

zBook.SaveAs Fpath: zBook.Close

zExcel.Quit: Set zExcel = Nothing

End Sub

Recordset sang Word không vòng lặp VB6

(Cần chèn thư viện ADO trước để khai báo ByVal Re As Recordset không bị lỗi)

Private Sub Recorset2Word(ByVal Re As Recordset, Fpath As String)

Dim zWord As Object: Set zWord = CreateObject("Word.Application")

Dim zDoc As Object: Set zDoc = zWord.Documents.Add

Dim NRow&: NRow = rs.RecordCount + 1 ' thêm tên côt khi create table

Dim NCol&: NCol = rs.Fields.Count ' Created by truongphu

Clipboard.Clear

Dim MM$, i&

For i = 0 To NCol - 1 ' ghi tên môi côt

   If i < NCol - 1 Then

        MM = MM & Re.Fields(i).Name & vbTab

    Else

        MM = MM & Re.Fields(i).Name & vbCrLf

    End If

Next

Clipboard.SetText MM & Re.GetString(2, , , vbCrLf)

    With zDoc

        .Tables.Add Range:=zWord.Selection.Range, NumRows:=NRow, NumColumns:=NCol

        .Tables(1).Range.Paste

    End With

zDoc.SaveAs Fpath: zDoc.Close

zWord.Quit: Set zWord = Nothing

End Sub

Cách dùng: vd code:

Private Sub Command4_Click()

  Recorset2Word rs, App.Path & "\Doc1.doc"

End Sub

mà rs là recordset

Bạn có thể download Project VB6

Hay đọc các bài viết tương tự