saya punya contoh perintah untuk mengimport data di tabel access ke excel :
Export2XL 3, ".\BIBLIO.MDB", "PUBLISHERS"
untuk koding di modulenya :
Public Function Export2XL(InitRow As Long, DBAccess As String, DBTable As
String) As Long
Dim cn As New ADODB.Connection 'Use for the connection string
Dim cmd As New ADODB.Command 'Use for the command for the DB
Dim rs As New ADODB.Recordset 'Recordset return from the DB
Dim MyIndex As Integer 'Used for Index
Dim MyRecordCount As Long 'Store the number of record on
the table
Dim MyFieldCount As Integer 'Store the number of fields
or column
Dim ApExcel As Object 'To open Excel
Dim MyCol As String
Dim Response As Integer
Set ApExcel = CreateObject("Excel.application") 'Creates an object
ApExcel.Visible = True 'This enable
you to see the process in Excel
ApExcel.Workbooks.Add 'Adds a new book.
'Set the connection string
cn.ConnectionString = "Provider=sqloledb.1;" & _
"Password=barakuda;" & _
"user id = aconx;" & _
"initial catalog=merchant;" & _
"data source = svr_bandung"
'Open the connection
cn.Open
'Check that the connection is open
If cn.State = 0 Then cn.Open
Set cmd.ActiveConnection = cn
cmd.CommandText = DBTable
cmd.CommandType = adCmdTable
Set rs = cmd.Execute
'Count the number of fields or column
MyFieldCount = rs.Fields.Count
'Fill the first line with the name of the fields
For MyIndex = 0 To MyFieldCount - 1
ApExcel.Cells(InitRow, (MyIndex + 1)).Formula = rs.Fields(MyIndex).Name
'Write Title to a Cell
ApExcel.Cells(InitRow, (MyIndex + 1)).Font.Bold = True
ApExcel.Cells(InitRow, (MyIndex + 1)).interior.colorindex = 36
ApExcel.Cells(InitRow, (MyIndex + 1)).WrapText = True
Next
'Draw border on the title line
MyCol = Chr((64 + MyIndex)) & InitRow
ApExcel.Range("A" & InitRow & ":" & MyCol).Borders.Color = RGB(0, 0, 0)
MyRecordCount = 1 + InitRow
'Fill the excel book with the values from the database
Do While rs.EOF = False
For MyIndex = 1 To MyFieldCount
ApExcel.Cells(MyRecordCount, MyIndex).Formula = rs((MyIndex -
1)).Value 'Write Value to a Cell
ApExcel.Cells(MyRecordCount, MyIndex).WrapText = False 'Format the Cell
Next
MyRecordCount = MyRecordCount + 1
rs.MoveNext
If MyRecordCount > 50 Then
Exit Do
End If
Loop
'Suggest to the user to save it's work
Response = MsgBox("Save the Excel Sheet and clik OK", vbOKOnly, "Save your
file")
'Close the connection with the DB
rs.Close
'Return the last position in the workbook
Export2XL = MyRecordCount
End Function
HASILNYA BERJALAN, yang mau saya tanyakan bagaimana koding untuk database
menggunakan sql server 2000
MOHON SEKALI PENCERAHANNYA ...thanks all vb-ers
[Non-text portions of this message have been removed]
