Datei auf Desktop speichern

Guten Abend
Ich öffne mit unterstehenden Code das Dialogfenster zum speichern auf. Dummerweise befindet sich auf dem Desktop ein Ordner mit dem selben Name wie die Datei welche ich speichern möchte.
Nach Eingabe des Namen öffnet sich jedoch der Ordnen und speichert nicht wie gewünscht die Datei auf den Desktop. Kann man dies irgendwie umgehen?

Sub PDF_Generieren()
    Dim strOrdner As String
    Dim j As Long

    strOrdner = Environ("USERPROFILE") & "C:\"
    
    With Application.FileDialog(msoFileDialogSaveAs)
        .InitialFileName = strOrdner
        .Title = "Set 1 Band speichern"
        .ButtonName = "Datei speichern"
        .InitialView = msoFileDialogViewDetails
        .Show
        
        For j = 1 To .Filters.Count
            If UCase$(.Filters(j).Extensions) Like "*.PDF*" Then
                .FilterIndex = j: Exit For
            End If
        Next j
    End With
End Sub