CODEWITHSUNDEEP
vbaexcelms-accessexcel-2013
Alaeddin Dhahri
Alaeddin Dhahri

Reputation: 7

Import data from Excel to Ms Access using VB

I'm trying to import Data from Excel file to my Ms Access Database. I have a ready table in my Ms Access Database and an Import Form where I press the Import Button (That I designed) then select the Excel file in my computer and the data is imported. The problem is that my code work for only 1 sheet Excel file, means that it doesn't work if the file has multiple sheets in it, here is the code I wrote:

Private Sub ImportButton_Click()
Dim dlg As FileDialog, strFileName As String
Set dlg = Application.FileDialog(msoFileDialogFilePicker)
With dlg
.Title = "Select the Excel file to import"
.AllowMultiSelect = False
.Filters.Clear
.Filters.Add "Excel Files", "*.xls*", 1
.Filters.Add "All Files", "*.*",  
If .Show = -1 Then
strFileName = .SelectedItems(1)
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel8, "Personnel", strFileName, True
Else
Exit Sub
End If
End With
End Sub

So is there a way that I can loop through the sheets in the Excel file one by one? Thanks in advance. Update: this the new working code if anyone needs it.

Private Sub Command0_Click()

' Requires reference to Microsoft Office 11.0 Object Library.
   Dim fDialog As FileDialog
   Dim varFile As Variant

   ' Clear listbox contents.
   'Me.FileList.RowSource = ""

   ' Set up the File Dialog.
   Set fDialog = Application.FileDialog(msoFileDialogFilePicker)

   With fDialog

      .AllowMultiSelect = False
      .Filters.Add "Excel File", "*.xls"
      .Filters.Add "Excel File", "*.xlsx"

      If .Show = True Then

         'Loop through each file selected and add it to our list box.
         For Each varFile In .SelectedItems
         ' Label3.Caption = varFile

         Const acImport = 0
         Const acSpreadsheetTypeExcel9 = 8

         ''This gets the sheets to new tables
         GetSheets varFile

         Next
         MsgBox ("Import data successful!")
         End If
End With
End Sub


Sub GetSheets(strFileName)
   'Requires reference to the Microsoft Excel x.x Object Library

   Dim objXL As New Excel.Application
   Dim wkb As Excel.Workbook
   Dim wks As Object

   'objXL.Visible = True

   Set wkb = objXL.Workbooks.Open(strFileName)

   For Each wks In wkb.Worksheets
      DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, _
            "Personnel", strFileName, True, wks.Name & "$"
   Next

   'Tidy up
   wkb.Close
   Set wkb = Nothing
   objXL.Quit
   Set objXL = Nothing

End Su

b

Note: "Personnel" is the name of the table where I'm importing data to.

Upvotes: 0

Views: 2957

Answers (1)

Claudius
Claudius

Reputation: 1911

this may help you

Option Explicit

Sub AccImport()
    Dim acc As New Access.Application
    acc.OpenCurrentDatabase "C:\Users\Public\Database1.accdb"
    acc.DoCmd.TransferSpreadsheet _
            TransferType:=acImport, _
            SpreadSheetType:=acSpreadsheetTypeExcel12Xml, _
            TableName:="tblExcelImport", _
            Filename:=Application.ActiveWorkbook.FullName, _
            HasFieldNames:=True, _
            Range:="Folio_Data_original$A1:B10"
    acc.CloseCurrentDatabase
    acc.Quit
    Set acc = Nothing
End Sub

Link to question

Upvotes: 1

Related Questions