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

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

VG

Dirk

Do While Dateiname <> ""
    DoEvents
    Me.Caption = ImportPfad & Dateiname
 
    SuchWert = Left(Dateiname, Len(Dateiname) - 6)
    SuchErgebnisDWG = ImportPfad & SuchWert & "_D.dwg"
    SuchErgebnisPDF = ImportPfad & SuchWert & ".pdf"
 
        DoEvents
 
        'If OB_Update.Value = True Then
        Set rs = Cn.Execute("SELECT PROD_DEFINITION.PD_NUM FROM" & _
          "PROD_DEFINITION")
            If (rs!PD_NUM & "") = SuchWert Then
                ArtNr = (rs!PD_NUM & "")
                Print #F, SuchWert & "     =     " & ArtNr
                Dateiname = Dir
                Cn.Execute "Update PROD_DEFINITION Set M_ZNAME_PLINE = '" & _
                  SuchErgebnisDWG & "' Where PD_NUM = '" & SuchWert & "'"
            Else
                Print #F, SuchWert & "     =     " & "???"
                Dateiname = Dir
            End If
Loop
Close #F

VG

Dirk

'####NEU------------------------------------------------------------------------
Dim rs As New ADODB.Recordset
Set rs = Cn.Execute("select * FROM PROD_DEFINITION where PD_NUM = '" & Suchwert _
  & "'")
 
If Not rs.EOF Then
    Print #F, Suchwert; Tab(25); "="; Tab; Suchwert
Else
    Print #F, Suchwert; Tab(25); "="; Tab; "?" & "  muß geprüft werden"
End If
'####NEU------------------------------------------------------------------------

VG

Dirk

Zitat:

Ist SuchErgebnisDWG = Suchwert dann schreibe in die *.txt Bei folgenden Dateien gab es eine Übereinstimmung: xxxxxx xxxxxx Ist SuchErgebnisDWG <> Suchwert dann schreibe in die *.txt Bei folgenden Dateien gab es keine Übereinstimmung: xxxxxx xxxxxx

Zitat:

Damit hast du natürlich ein Ergebnis für diesen einen Datensatz. Du kannst auch diesen Teil des Codes für jeden Datensatz wiederholen, und hast damit eine vollständige, aber unsortierte Liste.

VG

Dirk