şöyle bir kod var bunu bizdeki koda nasıl uyarlayabiliriz.

' 1. get the file name

' 2. open it

' 3. import the first sheet

' 4. check if there is more sheets, and import them as well.



' 1. loop over all tables

' 2. for each file - import the data in loop - for each sheet

' 3. pre-req - all sheets has to have headers with correct columns





Private Sub btnImportFromExcel_Click()

    Const FUNC_NAME As String = MOD_NAME & "." & "btnImportFromExcel_Click"

    On Error GoTo Sub_err



    Dim rsFileToImport As Recordset

    Dim wbFile As Workbook

    Dim sFileName As String

    Dim sFilePath As String

    Dim sTableName As String

    Dim i As Long

    Dim sMissingFiles As String



    Set rsFileToImport = GetRS("Q_ImportRelevant")



    While Not (rsFileToImport.EOF)

        ' Open the file



        sFileName = rsFileToImport("sTableName")

        sFilePath = Me.txtFilesPath & "\" & sFileName

        If FileExists(sFilePath) Then



            Set wbFile = Workbooks.Open(sFilePath)

            sTableName = Left(sFileName, Len(sFileName) - 4)



            ' Import and create the table

            DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, sTableName, sFilePath, True, "Sheet0!"

            SetStatusBar "Importing: " & sFileName & ", Sheet0"



            ' Import data from the rest of the sheets.

            i = 0

            For i = 1 To wbFile.Sheets.Count - 1

                DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, sTableName, sFilePath, True, "Sheet" & i & "!"

                SetStatusBar "Importing: " & sFileName & ", Sheet" & i & "/" & wbFile.Sheets.Count - 1

            Next i

        Else

            sMissingFiles = sMissingFiles & vbNewLine & sFileName

        End If



        wbFile.Close

        SetStatusBar "Import " & sFileName & " Finished"



        rsFileToImport.MoveNext

    Wend



    MsgBox "Missing files:" & sMissingFiles

    SetStatusBar "Import Finish"



Sub_exit:

    Exit Sub

Sub_err:

    ErrMsgBox Err.Number, FUNC_NAME & "[" & Erl & "]" & "\" & Err.Source, Err.Description & vbNewLine & sFileName & " (sheet" & i & ")"

    Resume Sub_exit

End Sub