Bagaimana cara mengimpor beberapa file excel ke akses?

Selamat,

Saya punya sedikit masalah. tujuannya adalah untuk membuat tabel tunggal yang disebut 'tbl_MasterStockFile' di MS Access dari mengimpor beberapa spreadsheet yang terletak di buku kerja terpisah

(OMONG-OMONG. Struktur kolomnya sama di semua spreadsheet dengan baris pertama adalah nama bidang)

Saya butuh bantuan untuk mencapai hal berikut yang dimulai dari tombol perintah yang disebut 'Impor Stok/Produk'

1. Hapus semua tabel yang memiliki nama yang mengandung 'tbl_import'

2. Berikan dialog File/Buka yang memungkinkan pengguna untuk memilih satu atau lebih spreadsheet Excel untuk diimpor, sangat mirip dengan kode pilihan tunggal di sini

http. // www. mrexcel. com/board2/viewtopic. php?to=85521 sorot=buka file+dialog+akses

2. Setelah pengguna memilih satu atau lebih spreadsheet, maka (Menggunakan perintah 'Transferspreadsheet') sebuah tabel akan dibuat per spreadsheet, dengan spreadsheet baris pertama = nama bidang yaitu ('Memiliki Nama Bidang = Ya')

Nama tabel perlu dibangun sebagai berikut

tbl_import_filename

filename = nama file spreadsheet tanpa. ekstensi xls

3. Setiap tabel (tbl_import_filename) memerlukan penghapusan catatan kosong (Perintah Transferspreadsheet tampaknya membawa catatan kosong?)

4. Semua catatan di semua tabel (tbl_import_filename(s)) perlu digabungkan dan duplikatnya dihapus. Catatan duplikat berdasarkan kolom di spreadsheet yang disebut 'StockID/Barcode' akan digunakan karena kolom ini harus unik

5. Sebuah tabel perlu dibuat dengan nama 'tbl_MasterStockFile' dan gabungan (tbl_import_filename(s)) tanpa catatan duplikat perlu diimpor ke 'tbl_MasterStockFile'

Adakah yang bisa membantu?

 

Ulang. Pilih dan Impor Beberapa Spreadsheet Excel ke Access

Anda sebenarnya memiliki cukup banyak pengimporan yang rumit untuk dilakukan
Dan, pada dasarnya saya sudah menerapkan apa yang Anda gambarkan

Sebuah saran tentang teknik

Jika Anda menamai judul kolom dengan benar (nama bidang), Anda dapat mengimpor spreadsheet langsung ke tabel tujuan. dan setiap impor akan ditambahkan secara otomatis ke tabel (tidak ditimpa) dengan DoCmd. Metode TransferSpreadsheet

Menghapus tabel secara massal agak sederhana. Berikut adalah contoh saya membunuh tabel kesalahan. Ini, tentu saja, hanya mematikan tabel yang cocok dengan sebagian string dari nama lengkap

Kode

 For Each tbl In dbs.TableDefs
     If Left(tbl.Name, 21) = "AutoExporting$_Import" Then
        DoCmd.DeleteObject acTable, tbl.Name
     End If
 Next tbl

Berikut adalah contoh pemanggilan fungsi yang membersihkan catatan 'kosong'

Kode

Public Function PurgeEmptyRecords(ByVal strTbl As String, ByVal x As Integer, ByVal y As Integer)
Dim dbs As DAO.Database
Dim rs As DAO.Recordset

Set dbs = CurrentDb

Set rs = dbs.OpenRecordset("Select * from " & strTbl, dbOpenDynaset)

With rs   ' Tests Two fields for Null, if both are, it purges entire record
  Do Until rs.EOF
    If IsNull(.Fields(x).Value) And IsNull(.Fields(y).Value) Then
      .Delete
    End If
    .MoveNext
  Loop
End With

Set rs = Nothing
Set dbs = Nothing
End Function

_

Untuk mengimpor, ada tiga pendekatan
1) Buat tabel dengan jalur lengkap ke setiap lokasi file dalam satu bidang dan iterasi melalui tabel itu dengan mengirimkan informasi ke kode Anda untuk diimpor (transferspreadsheet) masing-masing secara bergantian

2) Gunakan dialog buka file untuk mengembalikan jalur folder (bukan jalur file) - lalu impor seluruh folder (berguna jika Anda tidak tahu namanya tetapi secara konsisten seluruh direktori

3) Anda dapat menyetel kotak kombo & kotak daftar ke 'pilihan banyak' - Saya belum menguji teknik ini tetapi harus memungkinkan untuk memilih beberapa item dan meneruskannya sebagai daftar ke fungsi lain

Kode

Public Function ImportExcel(ByVal tblName As String)
Dim dbs As DAO.Database
Dim rs As DAO.Recordset
Dim rsf As DAO.Recordset
Dim tbl As TableDef
Dim strTLoc, strFLoc, strSQL As String
Dim errNumber As Long
Dim strXLS As String

Set dbs = CurrentDb

strSQL = "SELECT * FROM " & tblName

Set rs = dbs.OpenRecordset(strSQL, dbOpenDynaset)
Set rsf = rs.OpenRecordset()

strSQL = "DELETE * FROM tblData"
DoCmd.RunSQL strSQL    ' Empties tblData prep for Import Process

With rsf
  Do Until rsf.EOF
    strFLoc = .Fields(2)
    'strFLoc = FindDefaults("DefaultOpenLocation") & Right(!f_name, 4) & "\" & !f_name & ".xls"
       If ValidateLocations(strFLoc) Then       ' Does the file location exist
         Call ImportExport("acImport", "tblData", strFLoc)
       End If
    .MoveNext
  Loop
End With

Set rsf = Nothing
Set rs = Nothing

Call PurgeEmptyRecords("tblData", 0, 1)   ' Table to test, Field1 to test, 

 ' This eliminates all the import error tables
 For Each tbl In dbs.TableDefs
     If Left(tbl.Name, 21) = "AutoExporting$_Import" Then
        DoCmd.DeleteObject acTable, tbl.Name
     End If
 Next tbl

'Set rst = Nothing
Set dbs = Nothing
End Function

Public Function ImportExport(ByVal Ltype As String, ByVal Tname As String, _
                                 ByVal TLoc As String) As Long
Dim intCnt As Integer

Select Case Ltype:
    Case "acImport":  Ltype = 0
      'DoCmd.TransferSpreadsheet acImport, 8, Tname, TLoc, True, ""
    Case "acExport":  Ltype = 1
      'DoCmd.TransferSpreadsheet acExport, 8, Tname, TLoc, True, ""
    Case "acLink":    Ltype = 2
      'DoCmd.TransferSpreadsheet acLink, 8, Tname, TLoc, True, ""
End Select
DoCmd.TransferSpreadsheet " " & Ltype, 8, Tname, TLoc, True, ""

End Function

Itulah sebagian besar contoh teknik yang Anda perlukan - meskipun saya jamin Anda harus mengedit/menghapus/mengubah beberapa di antaranya untuk membuatnya berfungsi

Semoga beruntung

Mike

 

Ulang. Pilih dan Impor Beberapa Spreadsheet Excel ke Access

Sebagian jawaban
Tautan pertama sebenarnya adalah kode yang saya kutip beberapa bulan lalu (dan Anda kutip di posting awal Anda di utas ini)

Milik saya sedikit dimodifikasi - kosmetik di mana jenis file yang ingin saya tawarkan filter dan fungsi khusus (FindDefaults) yang baru saja mengekstrak lokasi default untuk memulai - yang mengakses tabel. Itu hanya menggunakan tabel seperti file INI

Tapi, hampir semua yang Anda butuhkan sudah ada di sana
Tautan multi-pilihan. itu juga mereferensikan kode Ken Getz. tampaknya terkait dengan mengekstraksi data file teks

Dan meninjau itu -- semua DoCmd itu. Hal-hal TransferText tampaknya menggunakan Spesifikasi Impor. Spesifikasi Impor adalah cara membuat template untuk impor. Buka panduan impor (manual) - dan impor salah satu file Anda. Pergi sampai akhir, *tepat sebelum* Anda menekan Finish. Tekan tab lanjutan di kiri bawah dan SIMPAN spesifikasi dengan nama unik

Lain kali Anda menginginkan format file itu, gunakan kembali spesifikasi yang sama
Periksa bantuan untuk sintaks atau gunakan sesuatu seperti

Kode

Sub ImportRoutine(spec As String, tblA As String, dstFile As String)

  DoCmd.TransferText acImportFixed, spec, tblA, dstFile

End Sub

Multi-pilih tampak menarik. Saya harus meninjaunya untuk melihat apakah benar-benar ada perubahan. Dugaan pertama saya adalah bahwa ini adalah modifikasi kecil pada keseluruhan kode

Pendekatan pribadi saya untuk hal semacam ini adalah menggunakan dialog Buka File untuk membuka folder dan kemudian mengembalikan semua file di folder ke tabel. dan kemudian berjalan melalui tabel untuk mengimpor file. Saya dapat dengan mudah mengimpor saat saya mengambil nama file

Edit saya
Saya memotong segmen yang relevan (itu yang terakhir) di tautan kedua Anda ke dalam modul kode akses. Saya menyiapkan panggilan cepat untuk itu

Kode

Sub dothebrowse()

apiBrowseFiles

End Sub

_

Bekerja seperti pesona bagi saya - tidak ada perubahan
Jika tidak berjalan untuk Anda, kemungkinan besar alasannya adalah Anda kehilangan referensi
Pastikan Microsoft Scripting Runting dicentang (dalam modul kode apa pun, Tools-References. Gulir untuk menemukan entri yang perlu Anda periksa)

Kode mengembalikan file yang Anda inginkan - sub Anda (seperti milik saya di atas) perlu menerima file dan melakukan sesuatu dengannya. Aka menambahkan sesuatu seperti

Dim aaa As Varian
aaa = apiBrowseFiles

Mike

 

sebuah metode

Inilah metode paling sederhana
Buat tabel dengan dua bidang. Bidang pertama adalah jalur lengkap ke file yang ingin Anda impor. Kedua adalah nama tabel yang ingin Anda gunakan setelah diimpor

Gantikan nama tabel Anda dengan tblName hanya beberapa baris di bawah ini

Kode

Function GetMyTables()
Dim dbs as DAO.Database
Dim rs As DAO.Recordset
Dim strSQL As String

Set dbs = CurrentDb()

strSQL = "SELECT * FROM tblName"
Set rs = dbs.OpenRecordset(strSQL, dbOpenSnapshot)

With rs
  Do Until rs.EOF
    ImportExport("acImport", .Fields(1).Value, .Fields(0).Value)
    .MoveNext
  Loop
End With

Set rs = Nothing
Set dbs = Nothing
End Function

Public Function ImportExport(ByVal Ltype As String, ByVal Tname As String, _ 
                                 ByVal TLoc As String) As Long 
Dim intCnt As Integer 

Select Case Ltype: 
    Case "acImport":  Ltype = 0 
      'DoCmd.TransferSpreadsheet acImport, 8, Tname, TLoc, True, "" 
    Case "acExport":  Ltype = 1 
      'DoCmd.TransferSpreadsheet acExport, 8, Tname, TLoc, True, "" 
    Case "acLink":    Ltype = 2 
      'DoCmd.TransferSpreadsheet acLink, 8, Tname, TLoc, True, "" 
End Select 
DoCmd.TransferSpreadsheet " " & Ltype, 8, Tname, TLoc, True, "" 

End Function

Ini tidak akan memiliki fleksibilitas untuk memilih apa yang Anda impor

Opsi #2 - menggunakan API. Pendekatan lain, berguna jika Anda perlu menyimpan data adalah dengan mengimpor semua nama file dan menyimpannya ke dalam tabel. Berikut adalah fungsi di mana Anda dapat meneruskan folder awal ke pembersihan tersebut, lalu mengisi tabel bernama tblFiles dengan 2 bidang. Anda harus menyiapkan meja terlebih dahulu

Saya tidak memiliki kesempatan untuk memodifikasi satu bagian - saya mengambil nama file tersebut. file1. xls bukan hanya file1 untuk digunakan sebagai nama tabel. Anda ingin memotongnya

Kode

Public 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

'32-bit API declarations
Declare Function SHGetPathFromIDList Lib "shell32.dll" _
  Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long

Declare Function SHBrowseForFolder Lib "shell32.dll" _
Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long


Public Function ReturnAllFiles(Optional ByVal selDir As String) As Boolean
Dim DirName As String
Dim TempName, TempName2, TempName3 As String, FileNum As Integer
Dim dbs As DAO.Database
Dim rs As DAO.Recordset
Dim strSQL, strTbl As String
Dim lnCnt As Long

strTbl = "tblFiles"

Set dbs = CurrentDb
If ObjectExists("Table", strTbl) Then
  strTbl = "tblFiles"
  strSQL = "DELETE * FROM " & strTbl
  DoCmd.RunSQL strSQL
Else
  ' Create the Table
End If
'C:\DirectoryLocation
strSQL = "SELECT * FROM tblFiles"
Set rs = dbs.OpenRecordset(strSQL, dbOpenDynaset)
    
    FileNum = FreeFile
    If selDir <> "C:\" Then
      DirName = selDir
    Else
      DirName = GetDirectory2() & "\"
      If Len(DirName) = 0 Then
        ReturnAllFiles = False
        Exit Function
      End If
    End If
    
    TempName = Dir$(DirName, vbDirectory)

    While Len(TempName)
        If (TempName <> ".") And (TempName <> "..") Then    'get rid of "." and ".."
            TempName = DirName & TempName
            lnCnt = InStr(TempName, ".xls") - 7
            TempName2 = Right(TempName, Len(TempName) - lnCnt + 1)
            'GetAttr is a built-in function
            If GetAttr(TempName) <> vbDirectory Then
                'Debug.Print TempName
                rs.AddNew
                rs.Fields(0).Value = TempName2   ' file1.xls
                rs.Fields(1).Value = TempName     ' full path to file
                rs.Update
            End If
        End If
        TempName = Dir$
    Wend
    
    Close #FileNum

ReturnAllFiles = True

Set rs = Nothing
Set dbs = Nothing
End Function

Public Function GetDirectory2(Optional Msg) As String

    Dim bInfo As BROWSEINFO
    Dim path As String
    Dim R As Long, x As Long

'   Root folder = Desktop
    bInfo.pidlRoot = 0&

'   Title in the dialog
    If IsMissing(Msg) Then
        bInfo.lpszTitle = "Select a folder."
    Else
        bInfo.lpszTitle = Msg
    End If
    
'   Type of directory to return
    bInfo.ulFlags = &H1

'   Display the dialog
    x = SHBrowseForFolder(bInfo)
    
'   Parse the result
    path = Space$(512)
    R = SHGetPathFromIDList(ByVal x, ByVal path)
    If R Then
          x = InStr(path, Chr$(0))
        GetDirectory2 = Left(path, x - 1)
    Else
        GetDirectory2 = ""
    End If

End Function

_

Saya tidak yakin berapa banyak bantuan lebih lanjut yang bisa saya berikan. Tuntutan waktu saya sejak awal tahun tampaknya telah meledak dan saya tidak punya waktu untuk menulis penjelasan rinci - spesifik yang panjang. Semoga ini cukup bagi Anda untuk membuat sesuatu bekerja

Mike

 

Bagaimana cara mengimpor beberapa file Excel ke Access secara bersamaan?

Bagaimana cara mengimpor daftar dari Excel ke Access?