Abspeichern eines Pfades als UNC oder LW

Hallo,
ich habe eine Abfrage gebaut, zur Auswahl eines Speicherortes. Dieser kann in einem Netzwerk oder auch auf der lokalen Platte sein. Nun möchte ich diese Pfadangabe an eine Zelle übergeben, um die Auswahl nur einmal vornehmen zu müssen. Das klappt auch alles super, solange ich einen Netzwerspfad (UNC-Pfad) auswähle. Wenn ich aber einen Lokalen Speicherort wähle, dann wird der nicht eingetragen ind der Zielzelle.
Ich übergebe den Wert mit
Set AppShell = CreateObject("Shell.Application")
Set BrowseDir = AppShell.BrowseForFolder(0, "Ordner auswählen", &H1000, 17)
On Error Resume Next
DateiPfad = BrowseDir.items().Item().Path
If DateiPfad = "" Then Exit Sub
'MsgBox UNCPath(DateiPfad)
On Error GoTo ENDE:
Worksheets("Bedienungsanleitung").Range("G46").Value = UNCPath (DateiPfad)

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Hansueli,
klar, verstehe ich.
Hier der Code:

Sub ZeitnachweisDrucken()
Jahr = Range("E4").Text 'für Dateiname der Vorgesetztenmeldung
Dim DateiName As String 'für Dateiname der Vorgesetztenmeldung
Dim DateiPfad As String 'für Speicherpfad der Vorgesetztenmeldung
Dim AppShell As Object 'für Ordnerauswahl zum Speichern
Dim BrowseDir As Variant 'für Ordnerauswahl zum Speichern
' Dim Pfad As String 'für Ordnerauswahl zum Speichern
Dim UNC As String * 512
DateiPfad = Worksheets("Bedienungsanleitung").Range("G46").Value 'übergibt den Eintrag  _
Speicherpfad aus Tabellenblatt "Bedienungsanleitung" Zelle G46 an Variable "Dateipfad"
'MsgBox DateiPfad
If DateiPfad = "" Then 'wenn kein Speicherpfad eingetragen ist, dann
START:    '***Aufruf der Ordnerauswahl***
Set AppShell = CreateObject("Shell.Application")
Set BrowseDir = AppShell.BrowseForFolder(0, "Ordner auswählen", &H1000, 17)
On Error Resume Next
DateiPfad = BrowseDir.items().Item().Path
If DateiPfad = "" Then Exit Sub
'MsgBox UNCPath(DateiPfad)
On Error GoTo ENDE:
Worksheets("Bedienungsanleitung").Range("G46").Value = UNCPath(DateiPfad)
End If
'    Else
DateiName = DateiPfad & "\" & Range("D6") & "_" & Range("J4") & "_" & Jahr & ".pdf"
'MsgBox DateiName & "Test"
If MsgBox("Möchten Sie die Vorgesetztenmeldung unter " & Chr(13) & DateiName & " speichern.",  _
vbYesNo) = vbYes Then
Range("a46:o86").Select
On Error GoTo ENDE:
Selection.ExportAsFixedFormat Type:=xlTypePDF, Filename:=DateiName, _
Quality:=xlQualityStandard, IncludeDocProperties:=False, _
IgnorePrintAreas:=False, OpenAfterPublish:=False
Else
If MsgBox("Neuen Zielpfad eingeben.", vbYesNo) = vbYes Then
GoTo START:
Else: Exit Sub
End If
End If
If MsgBox("Möchten Sie die Vorgesetztenmeldung öffnen", vbYesNo) = vbYes Then
ActiveWorkbook.FollowHyperlink DateiName
Range("D10").Select
Else
Range("D10").Select
End If
Exit Sub
ENDE:
If MsgBox("Datei konnte nicht gespeichert werden. Bitte prüfen Sie den Speicherpfad für  _
Vorgesetztenmeldung im Tabellenblatt 'Bedienungsanleitung'.", , "Fehlermeldung") = vbOK Then
Worksheets("Bedienungsanleitung").Activate
Worksheets("Bedienungsanleitung").Range("G46").Select
End If
End Sub

Beliebteste Forumthreads (12 Monate)

Abspeichern eines Pfades als UNC oder LW

3 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread