Setelah kita tahu bagaimana mengkonversi data dari excel ke database access sekarang bagaimana kalau kita ingin mengkonversi dari access ke excel???
Ikuti langkah di bawah ini.
1. Buat form seperti gambar disamping.
2. Tambahkan Microsoft excel 12.0 library (untuk excel 2007)
3. Masuk ke coding dan ketik script di bawah ini..
Private Declare Function ShellExecute Lib "Shell32.dll" Alias
"ShellExecuteA" (ByVal hwnd As Long, ByVal lpszOp As String, ByVal
lpszFile As String, ByVal lpszParams As String, ByVal lpszDir As
String, ByVal FsShowCmd As Long) As Long
Dim Conn As New ADODB.Connection
Dim RS As ADODB.Recordset
Dim FLD As ADODB.Field
Sub KoneksI()
Set Conn = New ADODB.Connection
Set RS = New ADODB.Recordset
Conn.Open "provider=microsoft.jet.oledb.4.0;data source= " & Label1 &
";peRSist security info =false"
End Sub
Private Sub Konversi()
Dim strExcelFile As String
Dim strWorksheet As String
Dim strDB As String
Dim strTable As String
strExcelFile = App.Path + "\" & List1 & ".xls"
strWorksheet = "WorkSheet1"
strDB = MdbFile
strTable = List1
Call KoneksI
If Dir(strExcelFile) <> "" Then
MsgBox "file sedang digunakan (terbuka)"
Exit Sub
End If
Conn.Execute "SELECT * INTO [Excel 8.0;DATABASE=" & strExcelFile &
"].[" & strWorksheet & "] FROM " & "[" & strTable & "]"
Conn.Close
End Sub
Private Sub Command1_Click()
CDialog.Filter = "Access Files (*.mdb)"
CDialog.FilterIndex = 0
CDialog.FileName = "*.mdb"
CDialog.ShowOpen
MdbFile = (CDialog.FileName)
List1.Clear
Label1 = MdbFile
Conn.Open "provider=microsoft.jet.oledb.4.0;data source= " & MdbFile
& ";peRSist security info =false"
Set RS = Conn.OpenSchema(adSchemaTables)
Do Until RS.EOF
If Left(RS.Fields("Table_Name").Value, 4) <> "MSys" And
Left(RS.Fields("Table_Name").Value, 3) <> "sys" Then
List1.AddItem RS.Fields("table_name")
End If
RS.MoveNext
Loop
End Sub
Private Sub Form_Load()
Label1.Visible = False
End Sub
Private Sub list1_click()
Call Konversi
Dim Buka As Long
Dim STR As String
STR = App.Path + "\" & List1 & ".xls"
Buka = OpenDocument(STR)
End Sub
Function OpenDocument(ByVal DocName As String) As Long
Dim Scr_hDC As Long
OpenDocument = ShellExecute(Me.hwnd, "Open", DocName, "", "C:\",
SW_SHOWNORMAL)
End Function
Coba jalankan programnya!!!!!
Selamat Mencoba!!!!!!!!!
