Private Sub cmdDurchlauf_Click()
 
Dim tAcadApp As AcadApplication
Set tAcadApp = ThisDrawing.Application
Dim tAcadDoc As AcadDocument
 
If TextBox1.Text = "" Then GoTo MyErrorHandler
Dim Dateiname As String
Dim ImportPfad As String
ImportPfad = TextBox1.Value & "\"
Dim DateiZahl As String
Dim i As Integer
i = 0
DateiZahl = Dir$(ImportPfad & "*.dwg")
Do While DateiZahl <> ""
    i = i + 1
    DateiZahl = Dir$()
Loop
Me.ProgressBar1.Max = i
Dateiname = Dir(ImportPfad & "*.dwg")
 
Do While Dateiname <> ""
    Set tAcadDoc = tAcadApp.Documents.Open(ImportPfad & Dateiname)
    Me.Caption = Dateiname
'------------------------------------------------------------------
'??Nachdem die Zeichnung geladen/geöffnet wurde, erscheint nun eine
'??Dialogbox mit folgender Abfrage:
 
'###Titel = AutoCAD
'###Info = ...dwg enthält Erstellungselemente
'          In Blockeditor öffnen?
'###Auswahl = OK/Button     NEIN/Button     ABBRUCH/Button
'###Der Focus steht auf dem OK/Button
'------------------------------------------------------------------
 
    With tAcadDoc
        .SendCommand ("_shademode" & vbCr & "2d" & vbCr)
        .Regen acActiveViewport
        .PurgeAll
    ZoomExtents
        .Save
        .Close
    End With
 
    Dateiname = Dir
    If ProgressBar1 + 1 > ProgressBar1.Max Then Exit Do
    ProgressBar1 = ProgressBar1 + 1
    DoEvents
Loop
 
Me.Caption = "Durchlauf beendet"
ProgressBar1.Value = 0
 
    Exit Sub
MyErrorHandler:
    MsgBox "Es wurde kein Verzeichnis ausgewählt", 64, "Hinweis"
 
End Sub

'--Programmpause erzwingen (ca. 2 Sekunden) bis Dialogbox da ist--
Private Declare Sub apiSleep Lib "kernel32" Alias "Sleep" (ByVal _
lngMilliSeconds As Long)
 
'--zunächst die benötigten API-Deklarationen----------------------
Private Declare Sub keybd_event Lib "user32.dll" ( _
  ByVal bVk As Byte, _
  ByVal bScan As Byte, _
  ByVal dwFlags As Long, _
  ByVal dwExtraInfo As Long)
 
'--keybd_event dwFlags-Konstanten
Private Const KEYEVENTF_EXTENDEDKEY = &H1   'Erweiterte Tastatureingabe
Private Const KEYEVENTF_KEYUP = &H2         'Die angegebene Taste wird 
' losgelassen
 
Private Const VK_TAB = &H9                  'Tab Taste
Private Const VK_RETURN = &HD               'Enter Taste
...
...
Do While Dateiname <> ""
    Set tAcadDoc = tAcadApp.Documents.Open(ImportPfad & Dateiname)
    Me.Caption = Dateiname
'------------------------------------------------------------------
'??Nachdem die Zeichnung geladen/geöffnet wurde, erscheint nun eine
 
    Call apiSleep(2000)
 
    'Tab Taste drücken
    Call keybd_event(VK_TAB, 0&, 0&, 0&)
    'Tab Taste wieder loslassen
    Call keybd_event(VK_TAB, 0&, KEYEVENTF_KEYUP, 0&)
 
    'Enter Taste drücken
    Call keybd_event(VK_RETURN, 0&, 0&, 0&)
    'Enter Taste wieder loslassen
    Call keybd_event(VK_RETURN, 0&, KEYEVENTF_KEYUP, 0&)
...
...

VG

Dirk