Sub ImportExcelFile()
Dim strXLSFilename As String
Dim XLSApp As New Excel.Application
Dim wbFile As Excel.Workbook
Dim sh As Excel.Worksheet
strXLSFilename = "L:\temp\ImportInAccess\Daten.xlsx"
Dim strValue As String
Set wbFile = XLSApp.Workbooks.Open(strXLSFilename)
For Each sh In wbFile.Worksheets
strValue = sh.Range("A1").Value
Debug.Print strValue
InsertNewValue "Tab_Standorte", "Standort", strValue
strValue = sh.Range("C5").Value
Debug.Print strValue
InsertNewValue "tab_Materialien", "Material", strValue
Next
wbFile.Close False
XLSApp.Quit
End Sub
Sub InsertNewValue(strTable As String, strFieldname As String, strValue As String)
Dim rst As Recordset
Set rst = CurrentDb.OpenRecordset(strTable, dbOpenDynaset)
rst.FindFirst (strFieldname & " = """ & strValue & """")
If rst.NoMatch Then
rst.AddNew
rst.Fields(strFieldname) = strValue
rst.Update
End If
rst.Close
End Sub