Do While Dateiname <> ""
    ThisDrawing.SetVariable "ATTMODE", 0
    'Dim InsPkt(2) As Double
    InsPkt(0) = 0: InsPkt(1) = 0: InsPkt(2) = 0
    On Error Resume Next '###Fehlerbehandlung
    '###beim Einfügen einer Datei könnte hier der Laufzeitfehler ausgelöst
    ' werden
    Set BlockDef = ThisDrawing.ModelSpace.InsertBlock(InsPkt, ImportPfad & _
      Dateiname, 1, 1, 1, 0)
 
      If Err.Number > 0 Then
          If Err.Description = "Referenz auf sich selbst" Then
   '###MsgBox Dateiname & "!   " & "Fehlerhafte Datei, bitte prüfen", 64, 
   ' "Hinweis"
           Select Case MsgBox(Dateiname & "!   " & "Fehlerhafte Datei, bitte" & _
             "prüfen", _
                               vbInformation + vbRetryCancel, "Hinweis")
               Case vbCancel   '###Abbrechen / Einstellungen zurücksetzen
                   NewDoc.Close
                   With ThisDrawing
                       .Application.Preferences.Display.GraphicsWinModelBackgrn_
                         dCo_
                         lor = color2
                       .SetVariable "ATTMODE", 1
                       .WindowState = acMax
                   End With
                   Exit Sub
            End Select
         End If
    End If
 
    BlockDef.Update
 
    ...
    ...
 
    Dateiname = Dir
    If ProgressBar1 + 1 > ProgressBar1.Max Then Exit Do
    ProgressBar1 = ProgressBar1 + 1
    DoEvents
Loop
 
ProgressBar1.Value = 0
NewDoc.Close
With ThisDrawing
    .Application.Preferences.Display.GraphicsWinModelBackgrndColor = color2
    .SetVariable "ATTMODE", 1
    .WindowState = acMax   'Standardgröße
End With
Me.Caption = "Durchlauf beendet"
Me.CmbOK.SetFocus
 
End Sub