VBA-Skript zum Entpacken von Dateien - Es werden nur leere Ordner erstellt

Ich benutze den Code von Ron (http://www.rondebruin.nl/win/s7/win002.htm), um theoretisch eine Reihe von ZIP-Dateien in einem Ordner zu entpacken. Ich glaube, was ich unten habe, ist der Code, der jede Zip-Datei in meinem "Downloads" -Verzeichnis nimmt, einen neuen Ordner mit dem Namen der Zip-Datei ohne ".zip" erstellt und dann die Dateien in den neuen Ordner extrahiert. Ich erhalte keine Fehler (häufig wird der Laufzeitfehler 91 angezeigt), aber das Einzige, was passiert, ist, dass eine Reihe von Ordnern mit den richtigen Namen erstellt wird, die jedoch alle leer sind.

Sub UnZipMe()

Dim str_FILENAME As String, str_DIRECTORY As String, str_DESTINATION As String

'Your directory where zip file is kept
str_DIRECTORY = "C:\Users\Jennifer\Downloads\"

'Loop through all zip files in a given directory
str_FILENAME = Dir(str_DIRECTORY & "*.zip")

Do While Len(str_FILENAME) > 0
    Call Unzip1(str_DIRECTORY & str_FILENAME)
    Debug.Print str_FILENAME
    str_FILENAME = Dir
Loop

End Sub

Sub Unzip1(str_FILENAME As String)
    Dim oApp As Object
    Dim Fname As Variant
    Dim FnameTrunc As Variant
    Dim FnameLength As Long

    Fname = str_FILENAME
    FnameLength = Len(Fname)
    FnameTrunc = Left(Fname, FnameLength - 4) & "\"

    If Fname = False Then
        'Do nothing
    Else
        'Make the new folder in root folder
        MkDir FnameTrunc

        'Extract the files into the newly created folder
        Set oApp = CreateObject("Shell.Application")
        oApp.Namespace(FnameTrunc).CopyHere oApp.Namespace(Fname).items
    End If
End Sub