Option Explicit
 
Private Sub cmd_Taste_Click()
  TestExcelImport1
End Sub
 
Sub TestExcelImport1()
    Dim cnn1 As New ADODB.Connection
    Dim cnn2 As New ADODB.Connection
    Dim rst1 As New ADODB.Recordset
    Dim rst2 As New ADODB.Recordset
    Dim strFileName1 As String
    Dim strFileName2 As String
    Dim strSQL As String
    Dim I As Integer
 
'Beginn Excel-Teil
    strFileName1 = "F:\VB6-Daten\Test\ExcelToAccess\POS-Artikel.xlsx"
      'Bitte Filenamen editieren
    cnn1.Open "Provider=Microsoft.ACE.OLEDB.12.0;" & _
              "Data Source=" & strFileName1 & _
              ";Extended Properties='Excel 12.0 XML;HDR=yes';"
    rst1.Open "SELECT * FROM PosNr;", cnn1, adOpenForwardOnly '<<<< hier kommt 
    ' die Fehlermeldung !!
      'Tabellenblattname = PosNr (Nur ein Tabellenblatt mit 18 Spalten)
 
'Beginn Access-Teil
    strFileName2 = "F:\VB6-Daten\Test\ExcelToAccess\MfWRR-Auftrag.accdb" _
      'Bitte Filenamen editieren
    cnn2.Open "Provider=Microsoft.ACE.OLEDB.12.0;" & _
              "Data Source=" & strFileName2
    rst2.Open "SELECT T_MasterL.* FROM T_MasterL;", cnn2, adOpenKeyset, _
      adLockOptimistic _
    'Tabellennamen = T_MasterL
 
    Do While Not rst1.EOF
        rst2.AddNew
        For I = 0 To rst1.Fields.Count - 1
            rst2(I) = rst1(I)
        Next I
        rst2.Update
        rst1.MoveNext
    Loop
    rst1.Close
    rst2.Close
    cnn1.Close
    cnn2.Close
End Sub

Mit freundlichen Grüssen
Detlev