Private Sub findMyFiles(myPath As String, myFileSpec As String _
 Dim myFolder, myFolderLoop, FSO
Dim myFilNam As String
On Error GoTo fehlerende
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set myFolder = FSO.GetFolder(myPath)
    myFilNam = Dir$(FSO.BuildPath(myFolder.Path, myFileSpec), _
    vbNormal Or vbHidden Or vbSystem Or vbReadOnly)
 
Text1.Text = myFilNam
fehlerende:
End Sub

Sub DAO_ListTablesExcel()
Dim myArray(1000) As String, nF As Integer, nD As Integer
Dim dbd1, dbd2, dbd3, dbd4, dbd5, zähler
zähler = 0
nF = -1
nD = 0
Call findMyFiles(App.Path , "*.xls", myArray, nF, nD)
 
    Dim strDatei_Excel As String
    Dim DB1 As DAO.Database
    Dim tbl As DAO.TableDef
    strDatei_Excel = App.Path & Text1.Text
    Set DB1 = OpenDatabase(strDatei_Excel, False, False, "Excel 8.0;")
    For Each tbl In DB1.TableDefs
       zähler = zähler + 1
    If zähler = 1 Then
    tbl1.Text = tbl.Name
    End If
    If zähler = 2 Then
    tbl2.Text = tbl.Name
    End If
    If zähler = 3 Then
    tbl3.Text = tbl.Name
    End If
    If zähler = 4 Then
    tbl4.Text = tbl.Name
    End If
    If zähler = 5 Then
    tbl5.Text = tbl.Name
    End If
    Next
End Sub

Private Sub Command4_Click()
Call DAO_ListTablesExcel
 
    Dim strDatei_Excel As String    'Quelldatei Excel
    Dim strTab_Excel As String      'Tabellenblatt Excel
    Dim strTab_Excel2 As String      'Tabellenblatt Excel
    Dim strTab_Excel3 As String      'Tabellenblatt Excel
    Dim strTab_Excel4 As String      'Tabellenblatt Excel
    Dim strTab_Excel5 As String      'Tabellenblatt Excel
    Dim strDatei As String
    Dim strDatei_Access As String   'Zieldatei Access
    Dim strTab_Access As String     'Tabellenname Access
    Dim strSQL1 As String           '=Tabellenerstellungsabfrage
    Dim strSQL2 As String           '=Anfügeabfrage
    Dim strSQL3 As String           '=Anfügeabfrage
    Dim strSQL4 As String           '=Anfügeabfrage
    Dim strSQL5 As String           '=Anfügeabfrage
    Dim DB1 As DAO.Database         'Verweis auf Microsoft DAO 3.6 Object 
    ' Library setzen
 
 
    conn.Execute "DELETE * FROM TEST;" ' alte Dateien löschen
    strDatei = Text1.text
    strDatei_Excel = App.Path & Text1.Text
 
 
    strTab_Excel = tbl1.Text
    strTab_Excel2 = tbl2.Text
    strTab_Excel3 = tbl3.Text
    strTab_Excel4 = tbl4.Text
    strTab_Excel5 = tbl5.Text
    strDatei_Access = App.Path & "\test.mdb"
    strTab_Access = "TEST"
    Set DB1 = OpenDatabase(strDatei_Excel, False, False, "Excel 8.0;")
 
 
    strSQL1 = "INSERT INTO " & strTab_Access & " IN '" & strDatei_Access & "' " _
      & _
              "SELECT * " & _
              "FROM [" & strTab_Excel & "];"
 
 
    strSQL2 = "INSERT INTO " & strTab_Access & " IN '" & strDatei_Access & "' " _
      & _
              "SELECT * " & _
              "FROM [" & strTab_Excel2 & "];"
 
 
    strSQL3 = "INSERT INTO " & strTab_Access & " IN '" & strDatei_Access & "' " _
      & _
              "SELECT * " & _
              "FROM [" & strTab_Excel3 & "];"
 
 
    strSQL4 = "INSERT INTO " & strTab_Access & " IN '" & strDatei_Access & "' " _
      & _
              "SELECT * " & _
              "FROM [" & strTab_Excel4 & "];"
 
 
    strSQL5 = "INSERT INTO " & strTab_Access & " IN '" & strDatei_Access & "' " _
      & _
              "SELECT * " & _
              "FROM [" & strTab_Excel5 & "];"
 
    If tbl1.Text <> "" Then
    DB1.Execute strSQL1
    End If
    If tbl2.Text <> "" Then
    DB1.Execute strSQL2
    End If
    If tbl3.Text <> "" Then
    DB1.Execute strSQL3
    End If
    If tbl4.Text <> "" Then
    DB1.Execute strSQL4
    End If
    If tbl5.Text <> "" Then
    DB1.Execute strSQL5
    End If
 
    DB1.Close
 
    Set DB1 = Nothing
    MsgBox "Update erfolgreich", vbOKOnly, "Update:"
    End If
 
    End Sub