Private Sub cmdDurchlauf_Click()
'--Variablen für Verzeichnis / Dateiauswahl---------------------------------
Dim ImportPfad As String
Dim ExportPfad As String
Dim Dateiname As String
 
Dim SuchWert As String
Dim SuchErgebnisDWG As String
Dim SuchErgebnisPDF As String
'--ImportPfad und ExportPfad festlegen---------------------------------------
ImportPfad = TextBox1.Value & "\" 'Das Verzeichnis wird über Ordnerauswahl 
' ausgewählt
ExportPfad = ImportPfad
'--Variablen Allgemein-------------------------------------------------------
Dim DateiZahl As String, i As Integer
i = 0
DateiZahl = Dir$(ImportPfad & "*.dwg")
If DateiZahl = "" Then GoTo MyErrorHandler
Do While DateiZahl <> ""
    i = i + 1
    DateiZahl = Dir$()
Loop
Dateiname = Dir(ImportPfad & "*.dwg")
'##--Datenbankanbindung an die SQL - Datenbank--!!!
Dim Cn As New ADODB.Connection
With Cn
    .CursorLocation = "#######"
    .Provider = "#######"
    .ConnectionString = "Data Source='#######'; Initial Catalog='#######';User" & _
      "ID='#######';Password='#######'"
    .Open
End With
 
'--ab hier mein Test bislang--
Dim sFile As String
Dim F As Integer
sFile = ImportPfad & "\" & "\Protokoll.txt"
 
F = FreeFile
Open sFile For Output As #F
Print #F, "Folgende Block / Artikelverknüpfungen wurden erstellt: " & vbCrLf
 
Do While Dateiname <> ""
    DoEvents
    Me.Caption = ImportPfad & Dateiname
 
    SuchWert = Left(Dateiname, Len(Dateiname) - 6)
    SuchErgebnisDWG = ImportPfad & SuchWert & "_D.dwg"
    SuchErgebnisPDF = ImportPfad & SuchWert & ".pdf"
 
DoEvents
'--eigentlich müßte ja hier die Abfrage lauten wenn dann, dann schreibe in die 
' Protokolldatei
'--Bei folgenden Dateien kam es zu einer Übereinstimmung:
'--Blockname             /     Artikelbezeichnung
'--APV-150-STBL 65 mm          APV-150-STBL 65 mm
'--usw.
 
'--Bei folgenden Dateien kam es zu keiner Übereinstimmung:
'--Blockname             /     Artikelbezeichnung
'--APV-150-STBL 85 mm
'--usw.
If OB_Update.Value = True Then
    With Cn
        .Execute "Update PROD_DEFINITION Set M_ZNAME_PLINE = '" & _
          SuchErgebnisDWG & "' Where PD_NUM = '" & SuchWert & "'"
        .Execute "Update PROD_DEFINITION Set M_ZEICHNUNGSNAME = '" & _
        SuchErgebnisPDF & "' Where PD_NUM = '" & SuchWert & "'"
    End With
End If
 
Print #F, ImportPfad & SuchWert; vbCrLf; SuchErgebnisPDF
Dateiname = Dir
Loop
Close #F
 
Cn.Close
Set Cn = Nothing
 
    Exit Sub
MyErrorHandler:
    MsgBox "Es wurde kein Verzeichnis ausgewählt", 64, "Hinweis"
 
End Sub

VG

Dirk