Impor Sekumpulan File Microsoft Excel Dalam Satu Folder ke Database Microsoft Access Sekaligus

Terkadang kita butuh untuk menyatukan data dari bulan ke bulan atau bahkan minggu ke minggu yang berformat sama untuk dibuat laporan. Sebenarnya hal ini mungkin bisa diselesaikan sesimple ini:

1. Siapkan file master excel yang telah diberi nama untuk tiap kolomnya.
2. Buka file pertama
3. Blok semua data dari mulai row kedua
4. Copy paste ke file master
5. Ulangi langkah nomor dua sampai nomor tiga sampai file terakhir.

Mudah. Apalagi seandainya hanya terdapat 12 (dua belas) file (satu file tiap bulan selama setahun) yang datanya rata-rata hanya seribu baris, Lebih cepat dan pastinya prosesnya di komputer terasa ringan apalagi jika memakai komputer dengan prosessor sekelas Intel Core i3, i5 atau bahkan i7 dengan DDR3 4GB atau lebih.

Namun bagaimana apabila ternyata file yang akan disatukan itu ternyata direkap tiap minggu dan setiap file terdapat rata-rata 25.000 (dua puluh lima ribu) row?

Memang... masih memungkinkan dikerjakan dengan cara diatas, namun ada beberapa kekurangan, diantaranya:

1. Proses yang akan terasa lambat dan berat
2. Human error karena faktor lelah

Berangkat dari hal tersebut, maka Saya mencoba untuk mencari cara agar proses tersebut lebih cepat dan enteng prosesnya serta mengurangi faktor human error. Pilihan jatuh ke Micrososft Access karena disetiap komputer kemungkinan besar terdapat program tersebut dan kebanyakan pengguna tidak akan begitu merasa kesulitan karena tinggal dikirim saja filenya untuk dijalankan.

Setelah browsing akhirnya menemukan cara di website:
http://www.accessmvp.com/kdsnell/EXCEL_Import.htm#ImpBrsFldFiles
dengan cara menambahkan baris berikut pada Button:

Dim strPathFile As String, strFile As String, strPath As String
Dim strTable As String, strBrowseMsg As String
Dim blnHasFieldNames as Boolean
' Change this next line to True if the first row in EXCEL worksheet
' has field names
blnHasFieldNames = False

strBrowseMsg = "Select the folder that contains the EXCEL files:"
strPath = BrowseFolder(strBrowseMsg)
If strPath = "" Then
      MsgBox "No folder was selected.", vbOK, "No Selection"
      Exit Sub
End If

' Replace tablename with the real name of the table into which 
' the data are to be imported
strTable = "tablename"

strFile = Dir(strPath & "\*.xls")
Do While Len(strFile) > 0
      strPathFile = strPath & "\" & strFile
      DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, _
            strTable, strPathFile, blnHasFieldNames

' Uncomment out the next code step if you want to delete the 
' EXCEL file after it's been imported
'       Kill strPathFile

      strFile = Dir()
Loop

dan menggunakan module dari alamat: http://access.mvps.org/access/api/api0002.htm

Kodenya:

'************** Code Start **************
'This code was originally written by Terry Kreft.
'It is not to be altered or distributed,
'except as part of an application.
'You are free to use it in any application,
'provided the copyright notice is left unchanged.
'
'Code courtesy of
'Terry Kreft

Private Type BROWSEINFO
  hOwner As Long
  pidlRoot As Long
  pszDisplayName As String
  lpszTitle As String
  ulFlags As Long
  lpfn As Long
  lParam As Long
  iImage As Long
End Type

Private Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias _
            "SHGetPathFromIDListA" (ByVal pidl As Long, _
            ByVal pszPath As String) As Long
            
Private Declare Function SHBrowseForFolder Lib "shell32.dll" Alias _
            "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) _
            As Long
            
Private Const BIF_RETURNONLYFSDIRS = &H1
Public Function BrowseFolder(szDialogTitle As String) As String
  Dim X As Long, bi As BROWSEINFO, dwIList As Long
  Dim szPath As String, wPos As Integer
  
    With bi
        .hOwner = hWndAccessApp
        .lpszTitle = szDialogTitle
        .ulFlags = BIF_RETURNONLYFSDIRS
    End With
    
    dwIList = SHBrowseForFolder(bi)
    szPath = Space$(512)
    X = SHGetPathFromIDList(ByVal dwIList, ByVal szPath)
    
    If X Then
        wPos = InStr(szPath, Chr(0))
        BrowseFolder = Left$(szPath, wPos - 1)
    Else
        BrowseFolder = vbNullString
    End If
End Function
'*********** Code End *****************

Kode untuk modul tersebut menggunakan API dari Windows dan selama ini lancar digunakan pada Microsoft Access 32-bit. Namun ketika digunakan untuk Microsoft Access 64-bit, ternyata kode tersebut tidak jalan.

Setelah mencoba browsing untuk mencari caranya, akhirnya ketemu website:
http://www.jkp-ads.com/Articles/apideclarations.asp

dan berikutnya website:
http://www.experts-exchange.com/Programming/Languages/Scripting/Q_27714232.html

Bisa juga mempelajari lebih lanjut di:
http://msdn.microsoft.com/en-us/library/ee691831.aspx#odc_office2010_Compatibility32bit64bit_ApplicationProgrammingInterfaceCompatibility

Module di atas untuk Microsoft Access 64-bit adalah sebagai berikut:

'************** Code Start **************
'This code was originally written by Terry Kreft.
'It is not to be altered or distributed,
'except as part of an application.
'You are free to use it in any application,
'provided the copyright notice is left unchanged.
'
'Code courtesy of
'Terry Kreft

Private Type BROWSEINFO
  hOwner As LongPtr
  pidlRoot As LongPtr
  pszDisplayName As String
  lpszTitle As String
  ulFlags As Long
  lpfn As LongPtr
  lParam As LongPtr
  iImage As Long
End Type

Private Declare PtrSafe Function SHGetPathFromIDList Lib "shell32.dll" Alias _
            "SHGetPathFromIDListA" (ByVal pidl As LongPtr, _
            ByVal pszPath As String) As LongPtr
            
Private Declare PtrSafe Function SHBrowseForFolder Lib "shell32.dll" Alias _
            "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) _
            As LongPtr
            
Private Const BIF_RETURNONLYFSDIRS = &H1
Public Function BrowseFolder(szDialogTitle As String) As String
  Dim X As LongPtr, bi As BROWSEINFO, dwIList As LongPtr
  Dim szPath As String, wPos As Integer
  
    With bi
        .hOwner = hWndAccessApp
        .lpszTitle = szDialogTitle
        .ulFlags = BIF_RETURNONLYFSDIRS
    End With
    
    dwIList = SHBrowseForFolder(bi)
    szPath = Space$(512)
    X = SHGetPathFromIDList(ByVal dwIList, ByVal szPath)
    
    If X Then
        wPos = InStr(szPath, Chr(0))
        BrowseFolder = Left$(szPath, wPos - 1)
    Else
        BrowseFolder = vbNullString
    End If
End Function
'*********** Code End *****************

Contoh sederhana untuk aplikasi dan datanya bisa di download disini. Semoga bermanfaat.

API Functions that return a LONG value need to be modified to work in the 64-bit environment:

Private Declare PtrSafe Function SHGetPathFromIDList Lib "shell32.dll" Alias _

            "SHGetPathFromIDListA" (ByVal pidl As Long, _

            ByVal pszPath As String) As Long

            

Private Declare PtrSafe Function SHBrowseForFolder Lib "shell32.dll" Alias _

            "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) _

            As Long

This has to do with the way VBA interprets the Long datatype (the Long datatype in VBA is strictly a 32-bit datatype). Read up on that more here:

http://msdn.microsoft.com/en-us/library/ee691831.aspx#odc_office2010_Compatibility32bit64bit_ApplicationProgrammingInterfaceCompatibility

Also, if you must support both 32 and 64 bit environments, you should use conditional compilation to properly declare your statements in each environment. For example:

#if Win64 then

   Declare PtrSafe Function MyMathFunc Lib "User32" (ByVal N As LongLong) As LongLong

#else

   Declare Function MyMathFunc Lib "User32" (ByVal N As Long) As Long

#end if

The above also comes from the link posted earlier.

===============

OR

===============

If you just want to browse for a Folder:

Dim MyShell As Object

Set MyShell = CreateObject("Shell.Application").BrowseForFolder(0, "Select Folder", 0)

If Not MyShell Is Nothing Then

 MsgBox MyShell.self.Path

Else

  MsgBox "nothing"

End If

This works on any platform where the Windows Shell is installed (which is every machine running Windows, of any variety).