Results 1 to 3 of 3
  1. #1
    lere is offline Novice
    Windows 8 Access 2007
    Join Date
    Feb 2017
    Posts
    6

    Browse and select an excel file to import, then import all sheets into separate tables in access

    hello everyone, I need to create a vba code to browse for a file , select it and import all sheets in that file into different access tables!
    I already have this code, it works, but it imports only the first sheet. HOW CAN I MODIFY IT?

    Sub Import()
    Dim strPathFile As String


    Dim strTable As String, strBrowseMsg As String
    Dim strFilter As String, strInitialDirectory As String
    Dim blnHasFieldNames As Boolean




    blnHasFieldNames = True
    strBrowseMsg = "Select the EXCEL file:"
    ' Change C:\MyFolder\ to the path for the folder where the Browse
    ' window is to start (the initial directory). If you want to start in
    ' ACCESS' default folder, delete C:\MyFolder\ from the code line,
    ' leaving an empty string as the value being set as the initial
    ' directory
    strInitialDirectory = "C:\MyFolder"


    strPathFile = ahtCommonFileOpenSave(InitialDir:=strInitialDirect ory, _
    Filter:=strFilter, OpenFile:=False, _
    DialogTitle:=strBrowseMsg, _
    Flags:=ahtOFN_HIDEREADONLY)

    If strPathFile = "" Then
    MsgBox "No file 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 = "foglio2"


    DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, _
    strTable, strPathFile, blnHasFieldNames
    End Sub

  2. #2
    ranman256's Avatar
    ranman256 is offline VIP
    Windows Vista Access 2010 32bit
    Join Date
    Apr 2014
    Location
    Kentucky
    Posts
    8,949
    This code will run when user clicks the button, btnImportXL.
    it opens applet to pick file,
    then opens the excel file to get all the sheet names,
    closes the file
    imports all sheets

    Code:
       'user clicks import button
    btnImportXL_click()
      vFile =  UserPick1File ("c:\folder\")
      if vFile <> "" then ImportAllFilesAndSheets1File vFile
    end sub
    
    
    '-----------------
    Public Function UserPick1File(Optional pvPath)
    '-----------------
    Dim strTable As String
    Dim strFilePath As String
    Dim sDialog As String, sDecr  As String, sExt As String
    
    
    '===================
    'YOU MUST ADD REFERENCE : Microsoft Office 11.0 Object Library, in vbe menu, TOOLS, REFERENCES
    '===================
    
    With Application.FileDialog(msoFileDialogFilePicker)   
        .AllowMultiSelect = False
        .Title = "Locate a file to Import"
        .ButtonName = "Import"
        .Filters.Clear
        .Filters.Add "Excel Files", "*.xls;*.xlsx"
        .Filters.Add "All Files", "*.*"
        .InitialFileName = pvPath
        .InitialView = msoFileDialogViewList    'msoFileDialogViewThumbnail
        
            If .Show = 0 Then
               'There is a problem
               Exit Function
            End If
        
        'Save the first file selected
        UserPick1File = Trim(.SelectedItems(1))
    End With
    End Function
    
    
    
    '-----------------
    Public Sub ImportAllFilesAndSheets1File (ByVal pvFile)
    '-----------------
    Dim vFil, vTargT
    Dim i As Integer
    Dim sTbl As String, sSql As String
    Dim fso
    Dim oFolder, oFile
    Dim colTabs As Collection
    
    On Error GoTo errImp
    If Right(pvDir, 1) <> "\" Then pvDir = pvDir & "\"
    
    sTbl = "xlFile"
    
    
              '=========== YOU MUST HAVE 'EXCEL OBJECT LIBRARY' loaded via VBE menu, TOOLS, REFERENCES
    'msgbox YOU MUST HAVE 'EXCEL OBJECT LIBRARY' loaded ", , "DELETE THIS MsgBox"
    
    
           Set colTabs = getAllTabsInWB(pvFile)
           
           For Each vSheet In colTabs
    
                     'IMPORT THE WORKBOOK via sheet
                DoCmd.TransferSpreadsheet acImport,  vSheet, pvFile, True, vSheet
    
           Next
        End If
           
    Set colTabs = Nothing
    DoCmd.SetWarnings True
    Exit Sub
    
    errImp:
    MsgBox Err.Description, vbCritical, "clsImport:ImportData()" & Err
    Exit Sub
    Resume
    End Sub
    
    
    '-----------------
    Private Function getAllTabsInWB(ByVal pvFile) As Collection
    '-----------------
    Dim sht As Worksheet
    Dim col As New Collection
    Dim xl As excel.Application
    
      '=========== YOU MUST HAVE 'EXCEL OBJECT LIBRARY' loaded via VBE menu, TOOLS, REFERENCES
    Set xl = CreateObject("excel.application")
    With xl
        .Workbooks.Open pvFile
        For Each sht In xl.Sheets
           col.Add sht.Name
        Next
        .ActiveWorkbook.Close False
    End With
    Set getAllTabsInWB = col
    Set xl = Nothing
    End Function

  3. #3
    lere is offline Novice
    Windows 8 Access 2007
    Join Date
    Feb 2017
    Posts
    6

    Unhappy Sintax error

    Quote Originally Posted by ranman256 View Post
    This code will run when user clicks the button, btnImportXL.
    it opens applet to pick file,
    then opens the excel file to get all the sheet names,
    closes the file
    imports all sheets

    Code:
       'user clicks import button
    btnImportXL_click()
      vFile =  UserPick1File ("c:\folder\")
      if vFile <> "" then ImportAllFilesAndSheets1File vFile
    end sub
    
    
    '-----------------
    Public Function UserPick1File(Optional pvPath)
    '-----------------
    Dim strTable As String
    Dim strFilePath As String
    Dim sDialog As String, sDecr  As String, sExt As String
    
    
    '===================
    'YOU MUST ADD REFERENCE : Microsoft Office 11.0 Object Library, in vbe menu, TOOLS, REFERENCES
    '===================
    
    With Application.FileDialog(msoFileDialogFilePicker)   
        .AllowMultiSelect = False
        .Title = "Locate a file to Import"
        .ButtonName = "Import"
        .Filters.Clear
        .Filters.Add "Excel Files", "*.xls;*.xlsx"
        .Filters.Add "All Files", "*.*"
        .InitialFileName = pvPath
        .InitialView = msoFileDialogViewList    'msoFileDialogViewThumbnail
        
            If .Show = 0 Then
               'There is a problem
               Exit Function
            End If
        
        'Save the first file selected
        UserPick1File = Trim(.SelectedItems(1))
    End With
    End Function
    
    
    
    '-----------------
    Public Sub ImportAllFilesAndSheets1File (ByVal pvFile)
    '-----------------
    Dim vFil, vTargT
    Dim i As Integer
    Dim sTbl As String, sSql As String
    Dim fso
    Dim oFolder, oFile
    Dim colTabs As Collection
    
    On Error GoTo errImp
    If Right(pvDir, 1) <> "\" Then pvDir = pvDir & "\"
    
    sTbl = "xlFile"
    
    
              '=========== YOU MUST HAVE 'EXCEL OBJECT LIBRARY' loaded via VBE menu, TOOLS, REFERENCES
    'msgbox YOU MUST HAVE 'EXCEL OBJECT LIBRARY' loaded ", , "DELETE THIS MsgBox"
    
    
           Set colTabs = getAllTabsInWB(pvFile)
           
           For Each vSheet In colTabs
    
                     'IMPORT THE WORKBOOK via sheet
                DoCmd.TransferSpreadsheet acImport,  vSheet, pvFile, True, vSheet
    
           Next
        End If
           
    Set colTabs = Nothing
    DoCmd.SetWarnings True
    Exit Sub
    
    errImp:
    MsgBox Err.Description, vbCritical, "clsImport:ImportData()" & Err
    Exit Sub
    Resume
    End Sub
    
    
    '-----------------
    Private Function getAllTabsInWB(ByVal pvFile) As Collection
    '-----------------
    Dim sht As Worksheet
    Dim col As New Collection
    Dim xl As excel.Application
    
      '=========== YOU MUST HAVE 'EXCEL OBJECT LIBRARY' loaded via VBE menu, TOOLS, REFERENCES
    Set xl = CreateObject("excel.application")
    With xl
        .Workbooks.Open pvFile
        For Each sht In xl.Sheets
           col.Add sht.Name
        Next
        .ActiveWorkbook.Close False
    End With
    Set getAllTabsInWB = col
    Set xl = Nothing
    End Function

    THANK YOU, But it says sintax error related to btnImportXL_click()

Please reply to this thread with any new information or opinions.

Similar Threads

  1. Replies: 5
    Last Post: 08-31-2012, 02:59 PM
  2. Replies: 1
    Last Post: 08-25-2012, 06:11 PM
  3. Browse for Excel File and Import
    By AKQTS in forum Programming
    Replies: 1
    Last Post: 07-12-2011, 07:33 AM
  4. Import excel sheets to access.
    By calexandru in forum Import/Export Data
    Replies: 0
    Last Post: 08-19-2009, 09:44 AM
  5. Replies: 0
    Last Post: 04-29-2009, 04:27 PM

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  
Other Forums: Microsoft Office Forums