VBA FileDialog Access 2007

Option Compare Database
Option Explicit
Function Start_Import()
  Application.Run MehrereDateienImportierenV2
End Function
Sub MehrereDateienImportierenV2()

Const ZielTab = tab2010
  Dim oFileDialog As Office.FileDialog
  Set oFileDialog = Application.FileDialog(msoFileDialogFilePicker)
  With oFileDialog
    .Title = Dateien auswählen!
    .AllowMultiSelect = False
    .Filters.Add Nur CSV auswählen, *.csv
      
      Dim vItem As Variant
      For Each vItem In .SelectedItems
      
      EineTXTDateiEinlinkenUndAnfügen .SelectedItems(1), ZielTab
         
      Next
    End If
  End With



End Sub

Sub EineTXTDateiEinlinkenUndAnfügen(AktDatFullNam As String, _
                  ZielTab As String)
  Const TmpLink = TabtmpLink
  Const ImportSpez = Import_Spezifikation
 
  On Error Resume Next
  DoCmd.DeleteObject acTable, TmpLink
  On Error GoTo 0
  DoCmd.TransferText acLinkDelim, ImportSpez, TmpLink, AktDatFullNam
  
  CurrentDb.Execute INSERT INTO  & ZielTab & _
              SELECT  & TmpLink & .*  & _
               FROM  & TmpLink & ;
  CurrentDb.Execute DELETE *  & _
              FROM tab2010  & _
                WHERE Betrieb is null AND RgNummer is null
  DoCmd.DeleteObject acTable, TmpLink
End Sub

Sub EineTXTDateiEinlinkenUndAnfügen(AktDatFullNam As String, _
                  ZielTab As String)

Sub MehrereDateienImportierenV2()

Const ZielTab = tab2010
  Dim oFileDialog As Office.FileDialog
  
  Set oFileDialog = Application.FileDialog(msoFileDialogFilePicker)
  With oFileDialog
    .Title = Dateien auswählen!
    .AllowMultiSelect = True
    .Filters.Add Nur CSV auswählen, *.csv
    If .Show = -1 Then
      Dim vItem As Variant, sItem As String
      For Each vItem In .SelectedItems
       sItem = vItem
       EineTXTDateiEinlinkenUndAnfügen sItem, ZielTab
      Next
    End If
  End With

AUFRAEUMEN:
 Set oFileDialog = Nothing
End Sub

Const sVerzeichnis = d:\Test

Sub MehrereDateienImportierenV2()

'alle csv-Dateien des Verzeichnis

 Const ZielTab = tab2010
 Const sVerzeichnis = d:\Test

 Dim FSO As New Scripting.FileSystemObject->Erfordert Extras->Verweis->Microsoft Scripting Runtime
 Dim objD As Folder
 Dim objFile As File, objFiles As Files
 Set objD = FSO.GetFolder(sVerzeichnis)->Folder-Objekt erzeugen
 Set objFiles = objD.Files      ->Files-Objekt erzeugen

->Verzeichnis prüfen
 If Dir(sVerzeichnis, vbDirectory) =  Then
  MsgBox Verzeichnis  & sVerzeichnis & nicht vorhanden !
  GoTo AUFRAEUMEN
 End If

->Files im Verzeichnis feststellen
 Set objD = FSO.GetFolder(sVerzeichnis)->Folder-Objekt erzeugen
 Set objFiles = objD.Files      ->Files-Objekt erzeugen
 For Each objFile In objFiles
  If LCase(Right(objFile.Name, 4)) = .csv Then
   EineTXTDateiEinlinkenUndAnfügen objFile.Path, ZielTab
  End If
  Next
  
AUFRAEUMEN:
 Set FSO = Nothing: Set objD = Nothing: Set objFile = Nothing: Set objFiles = Nothing
End Sub