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

Besten Dank für Eure Hilfe.

Freundliche Grüsse Daniel Eberhard


Option Explicit

Sub PDF_Generieren()
    Dim strOrdner As String
    Dim j As Long
    Dim strDatei As String
    Dim intErgebnis As Integer
    '???
    'Environ("USERPROFILE") ist ein vollständiger Pfad=> c:\users\%User%C:\
    'strOrdner = Environ("USERPROFILE") & "C:\"
    strOrdner = Environ("USERPROFILE") & "\Desktop"
    strDatei = "Öfter" '"Öfter.pdf"
    With Application.FileDialog(msoFileDialogSaveAs)
        'InitialFileName not InitialDirectory !
        .InitialFileName = strOrdner & "\" & strDatei
        .Title = "Set 1 Band speichern"
        .ButtonName = "Datei speichern"
        .InitialView = msoFileDialogViewDetails
        For j = 1 To .Filters.Count
            If UCase$(.Filters(j).Extensions) Like "*.PDF*" Then
                .FilterIndex = j: Exit For
            End If
        Next j
        intErgebnis = .Show
        If intErgebnis > 0 Then
            strDatei = IIf(LCase(Right(.SelectedItems(1), 4)) > ".pdf", .SelectedItems(1) & ".pdf", .SelectedItems(1))
            ThisWorkbook.Worksheets(1).ExportAsFixedFormat xlTypePDF, strDatei
            MsgBox strDatei
        End If
    End With
End Sub

Resultiert zu

da ergänzt wird

und somit:

nach .Show ist Ende im Hook.
GetSaveFile wär vernünftiger und Inputbox auch, aber ich entscheide nicht
hth
Ulf

Forumthread: Datei auf Desktop speichern

9
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

Infobox / Tutorial