Sub importTESTcorrect()
   Dim sFile, sPath, sFileName, sFolder
   Dim idPreCon As Long
   Dim rst As Recordset
   Dim fd As FileDialog
   Dim appExcel As Object
   Dim wbkExcel 'As Excel.Workbook
  
   Set fd = Application.FileDialog(msoFileDialogFolderPicker)
   With fd
      If .Show = False Then Exit Sub
      .AllowMultiSelect = False
      sFolder = .SelectedItems(1)
   End With
   sPath = sFolder & "\" & "*.xlsm"
   sFile = Dir(sPath)
  Set appExcel = CreateObject("excel.application")
  
    Do While sFile <> ""
      sFileName = sFolder & "\" & sFile
      Set wbkExcel = appExcel.Workbooks.Open(sFileName)
      
      'idPreCon = wbkExcel.Worksheets("Функции").Range("R57").Value ЗАМЕНИТЬ НА:
      idPreCon = CurrentDb.OpenRecordset("SELECT * FROM [Функции$R57:R57] IN '" & sFileName & "' [Excel 12.0;HDR=NO;ImEx=1]").Fields(0)
      
      Set rst = CurrentDb.OpenRecordset("SELECT * FROM tPrescripts WHERE idPrescript = " & CStr(idPreCon))
      wbkExcel.Close False
        
        'rst.MoveLast
        If rst.RecordCount = 0 Then
        'импорт с первого листа
          Call DoCmd.TransferSpreadsheet(acImport, acSpreadsheetTypeExcel12, _
              "tPrescripts", sFileName, True, "requisites")
        'аналогичный импорт со второго листа ...
        'аналогичный импорт с третьего листа ...
        Else
          MsgBox "уже есть"
        End If
        
      sFile = Dir
    Loop
  appExcel.Quit
End Sub