VBA: Fester Netzwerkpfad mit GetOpenFilename

Hallo,
zu meinem Problem habe ich bereits die Suche im Archiv bemüht, habe aber leider nur teilweise Informationen dazu gefunden. (Nämlich das es so wie ich es mir vorstelle nicht geht (ChDir))
Ich habe ein Excelformular, das eine Importfunktion hat. Ich kann also Formulare mit älterer Versionsnummer in mein aktuelles Formular importieren.
(Die Versionsnummer vergebe ich selbst, wenn ich Änderungen im aktuellen Formular vornehme)
Die älteren Formulare befinden sich alle in einem Ordner. Alle Benutzer im Netzwerk sollen nun diese älteren Formulare in die aktuelle Version importieren können. So weit so gut. Momentan funktioniert das über GetOpenFilename.
Das einzige was nervt ist, dass sich jeder erst über das Dialogfeld durch die Pfade im Netzwerk winden muss, um an den Ordner mit den älteren Formularen zu kommen.
Ich suche jetzt nach einer Möglichkeit, GetOpenFilename mit einem festen Netzwerkpfad zu versehen um direkt in den gesuchten Ordner zu wechseln. Gibt es da eine Möglichkeit?
Vielen Dank für Euere Mühe.
Gruß Thorsten

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo
mal ohne API Funktionen sondern nur mit VBA-Bordmitteln
Der Zugriff auf das Netzlaufwerk muss OHNE Eingabe eines Benutzernamens und Passwortes möglich sein, sonst müsste man den Code etwas umschreibem

Option Explicit
Sub Open_File()
Dim i As Byte, x As Variant
Dim OrigDrive As String, FreeDrive As String
Dim defShare As String, defPath As String, defName As String
Dim openFile As String
Dim defDrive As String
OrigDrive = Left(ThisWorkbook.FullName, 1)
'Backslash beachten !!!
'Zur Freigabe auf dem jeweiligen Rechner
defShare = "\\ServerName\Freigabename"
'Unterstruktur bis zur Datei
defPath = "\Unterordner\"
'Dateiname
defName = "Datei.xls"
If myFreeDrive = "Null" Then
    'normales öffnen zum Browsen
    'wenn kein Laufwerksname mehr zur Verfügung steht
    openFile = Application.GetOpenFilename(defName & " (*.xls), *.xls")
Else
    defDrive = myFreeDrive
    'ERstellen eines temporären Netzlaufwerkes
    x = Shell("cmd.exe /C net use " & defDrive & ": " & defShare)
    'in das Verzeichnis wechseln
    ChDrive defDrive
    'in den Unterordner wechseln
    ChDir defDrive & ":" & defPath
    'dialog anzeigen
    openFile = Application.GetOpenFilename(defName & " (*.xls), *.xls")
    'Temporäres Laufwerk wieder löschen
    x = Shell("cmd.exe /C net use " & defDrive & " /Delete")
End If
'Die gewählte Datei öffnen
Workbooks.Open (openFile)
End Sub
Function myFreeDrive() As String
'(c) ramses
Dim myFSO As Object, myDrv As Object, drvCount, drvStr As String, vName As String, drvTyp As String
Dim drvmax As Byte, drvNum As Byte
Set myFSO = CreateObject("Scripting.FileSystemObject")
Set drvCount = myFSO.drives
For Each myDrv In drvCount
    Select Case myDrv.drivetype
        Case 3: drvmax = 90 - 1
        Case Else:
            If drvNum = 0 Then
                drvNum = Val(Asc(myDrv.DriveLetter))
            End If
            If drvNum < Val(Asc(myDrv.DriveLetter)) Then
                drvNum = Val(Asc(myDrv.DriveLetter))
            End If
    End Select
Next
If drvmax <= drvNum Then
    myFreeDrive = "Null"
Else
    myFreeDrive = Chr(drvNum + 1)
End If
End Function

Gruss Rainer

Beliebteste Forumthreads (12 Monate)

VBA: Fester Netzwerkpfad mit GetOpenFilename

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

103 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

VBA: Fester Netzwerkpfad mit GetOpenFilename

6 Beiträge zum Forumthread Beiträge zu diesem Forumthread

103 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread