AW: Zugriffsrechte ändern
12.06.2009 12:38:47
Ramses
Hallo
Hier mal ein Beispiel das Dir als Ansatz dienen soll.
Hatte ich vor längerer Zeit mal bei uns im Betrieb gebraucht
Sub Open_File_on_Not_Yet_Shared_Network_Drive()
'(C) by Ramses
'Öffnet den GetOpenFile-Dialog direkt auf eine Datei
'auf einem Netzlaufwerk dessen Server und Freigabe-Name zwar bekannt
'dessen LW-Bezeichnung jedoch nicht bekannt ist
'Kommt häufig vor in Firmen oder wenn manuelle
'Laufwerke gemappt werden, oder USB-Laufwerke
'verwendet werden, welche die normalen Laufwerksbezeichnungen
'verändern
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, defDrive As String
Dim shUsername As String, shPassword As String, shDomain 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"
'Username der auf die Netzwerkfreigabe zugreifen darf
shUsername = "Ramses"
'Passwort des berechtigten Users
shPassword = "Ramses"
'Eventuel Domäne in der der User bekannt ist
'wenn nicht aus der lokalen Domäne
shDomain = "Domäne"
If myFreeDrive = "Null" Then
'normales öffnen zum Browsen
'wenn kein Laufwerksname mehr zur Verfügung steht
MsgBox "Datei kann nicht direkt angezeigt werden." & Chr$(13) & _
"Die Datei: """ & defName & """ liegt auf: """ & defShare & defPath & """"
'Alle Laufwerksbezeichnungen sind verwendet
'Der User muss nun manuell auf die Datei browsen
openFile = Application.GetOpenFilename(defName & " (*.xls), *.xls")
Else
defDrive = myFreeDrive
'Erstellen eines temporären Netzlaufwerkes ohne Username und Passwort
x = Shell("cmd.exe /C net use " & defDrive & ": " & defShare)
'Erstellen eines temporären Netzlaufwerkes mit Username und Passwort
'Ohne Domäne
'x = Shell("cmd.exe /C net use " & defDrive & ": " & defShare & _
" " & shPassword & " /User:" & shUsername)
'Mit fremder Domäne
'x = Shell("cmd.exe /C net use " & defDrive & ": " & defShare & _
" " & shPassword & " /User:" & shDomain & "\" & shUsername)
'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
Gruss Rainer