' Die auszucheckenden Dateien müssen
' im aktuellen Tabellenblatt mit vollem Pfad
' (z.B.: C:\Tresorname\Ordner\Dateiname.Endung)
' in der ersten Spalte untereinander ohne Leerzellen
' aufgelistet sein.
' Die Dateiliste lässt sich im SQL Server Management Studio
' erstellen und die Zeilen mit Copy and Paste 
' in die Exceltabelle kopieren oder
' als csv-Datei speichern.
'
' Als Verweis muss "PDMWorks Enterprise 2020 Type Library" aktiviert werden


Option Explicit
Const VaultName="Tresorname"	'hier muss der Name des Tresors eingetragen werden
Dim FileCounter As Integer
Dim FileName As String
Dim ProblemFile() As String
Dim ProblemText() As String
Dim tempProblemText As String
Dim ErrorCounter As Integer
Dim i As Integer 'common counter

Sub main()
    Dim myVault As IEdmVault7
    Set myVault = New EdmVault5
    Dim myVault1 As IEdmVault11
    Dim swPdmFile As IEdmFile5
    Dim swPdmFolder As IEdmFolder5
    Dim FileName As String
    ErrorCounter = 0
    FileCounter = 0
  
    Call myVault.LoginAuto(VaultName, 0)

    ActiveSheet.Cells(1, 1).Select
    
    Do While ActiveCell.Value <> ""    'Repeat until empty cell is found
        tempProblemText = ""
        FileName = ActiveCell.Value 'must contain full path with filename
        
        On Error GoTo ErrorHandle
        
        Set swPdmFile = myVault.GetFileFromPath(FileName, swPdmFolder)

        If swPdmFile Is Nothing Or swPdmFolder Is Nothing Then
            Exit Do
        End If
        
        'Fehlertext festlegen, falls Datei bereits ausgecheckt
        If swPdmFile.IsLocked Then
            tempProblemText = "Locked on " & swPdmFile.LockedOnComputer & " by " & swPdmFile.LockedByUser.Name
        Else
            tempProblemText = "unbekannter Fehler"
        End If
        
        Call swPdmFile.LockFile(swPdmFolder.ID, 0)  'Datei auschecken
        
        On Error GoTo 0
        
        ActiveCell.Offset(1, 0).Select
        FileCounter = FileCounter + 1
    Loop
    
    MsgBox ("Processed " & FileCounter & " files" & vbCrLf & ErrorCounter & " errors occured")
    
    If ErrorCounter > 0 Then _
        If MsgBox("Fehlerdatei erstellen ?", vbOKCancel, "Fehlerdatei") = vbOK _
            Then Fehlerdatei_erstellen
    
    Exit Sub
    
ErrorHandle:
    ErrorCounter = ErrorCounter + 1
    ReDim Preserve ProblemFile(ErrorCounter)
    ProblemFile(ErrorCounter) = FileName
    ReDim Preserve ProblemText(ErrorCounter)
    ProblemText(ErrorCounter) = tempProblemText
    ActiveCell.Interior.ColorIndex = 7
    Resume Next
    
End Sub

Sub Fehlerdatei_erstellen()
    Application.Workbooks.Add
    Cells(1, 1).Activate
    For i = 1 To ErrorCounter
        ActiveCell.Value = ProblemFile(i)
        ActiveCell.Offset(0, 1).Value = ProblemText(i)
        ActiveCell.Offset(1, 0).Activate
    Next i
End Sub