Option Explicit
 
Private Sub Workbook_Open()
   Dim c, p As Integer
   Dim strFile, strUser   As String
   Dim objFileSystem As Object
   Dim objVerzeichnis As Object
   Dim objDateienliste As Object
   Dim objDatei As Object
   
   strUser = "<mein_user>"
   
   Set objFileSystem = CreateObject("scripting.FileSystemObject")
   Set objVerzeichnis = objFileSystem.GetFolder("C:\Users\" & strUser & "\Pictures\Sperrbildschirme")
   Set objDateienliste = objVerzeichnis.Files
   
   Randomize (Timer)
   c = 1
   
   For Each objDatei In objDateienliste
        If Not objDatei Is Nothing Then
             ActiveSheet.Cells(c, 1) = objDatei.Name
             c = c + 1
        End If
   Next objDatei
   
   c = c - 1
   p = Int(Rnd(Time) * c)
   While (p = 0) Or (p > c)
      p = Int(Rnd(Time) * c)
   Wend
      
   ActiveSheet.Cells(p, 1).Select
   strFile = ActiveSheet.Cells(p, 1)
   Kill "C:\Users\" & strUser & "\Pictures\Sperrbildschirm.jpg"
   Call CopyFile("C:\Users\" & strUser & "\Pictures\Sperrbildschirme\", "C:\Users\" & strUser & "\Pictures\", strFile)
   'ThisWorkbook.Close SaveChanges:=True
   
End Sub
 
Sub CopyFile(ByVal StrFromPath As String, ByVal StrToPath As String, ByVal strFile As String)
   Dim myFSO As Object
 
   Set myFSO = CreateObject("Scripting.FileSystemObject")
   myFSO.CopyFile StrFromPath & strFile, StrToPath & "Sperrbildschirm.jpg", True
End Sub