Moin Gemeinde,
ist es möglich von einem per WebDAV eingebunden Laufwerk den zugewiesenen Laufwerksbuchstaben auszulesen?
Allen ein schönes Wochenende
Hallo Gockel,
ich habe hier jetzt keine Laufwerke verbunden um das testen zu können, aber vielleicht hilft das so ins unreine geschriebenen schon um weiter zu kommen.
Public Sub FindWebDAVDrives()
Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
Dim drv As Object
For Each drv In fso.Drives
If drv.DriveType = 4 Then ' 4 steht für Netzwerklaufwerke
If IsWebDAVDrive(drv.ShareName) Then
Debug.Print "WebDAV-Laufwerk gefunden:"
Debug.Print " Laufwerksbuchstabe: " & drv.DriveLetter
Debug.Print " Freigabename: " & drv.ShareName
Debug.Print " Verfügbarer Speicherplatz: " & drv.AvailableSpace & " Bytes"
Debug.Print "-----------------------------"
End If
End If
Next drv
End Sub
Private Function IsWebDAVDrive(shareName As String) As Boolean
IsWebDAVDrive = (InStr(1, shareName, "http://", vbTextCompare) > 0) Or _
(InStr(1, shareName, "https://", vbTextCompare) > 0)
End Function
Gruß
Holger
Moin Holger,
wenn du mir jetzt noch verrätst wie ich das Teil aufrufe. Iwie tut sich da bei mir gar nichts.
Schönen Sonntag
Jörg
Hey, da die Ausgabe im Direktfenster geschieht, gehst Du einfach hin, im vba Fenster und startest die Sub FindWebDAVDrives.
Vorher aktivierst Du aber noch das Direktfenster. Dann lass es mal im Debugger laufen. Aber wie gesagt ich habe hier am NB nur eingeschränkte Möglichkeiten.
Holger
Morgen Holger,
genau so hab ich es gemacht. Nur tut sich wie gesagt nichts. Had dann mal verscht Debug.Print gegen MsgBox zu tauschen. Auch da passiert nichts.
Bisher geh ich bei der Pfadauswahl in meiner Datensicherung hin un wechsel nach auswahl der Datei den Pfad gegen den Laufwerksbuchstaben per Hand. Wäre halt schön gewesen das zu automatisieren.
Schönen Sonntag
P.S. Was ich bisher herausgefunden habe ist dass IsWebDAVDrive ein False zurückliefert.
Hey, versuch mal mit Debugger zu erforschen welche drv.DriveType er bei Dir findet einfach mal vor dem Next drv eine MsgBox drv.DriveType aufrufen. Vielleicht kommen wir so weiter.
Holger
Oder Liste Dir das mal kurz in einer Listbox auf (weiß ja nicht wie viele LW Du so hast:
Sub ListDrives()
Dim fso As Object
Dim drv As Object
Dim lstDrives As ListBox
Dim driveInfo As String
Set lstDrives = Me.lstdrive
Set fso = CreateObject("Scripting.FileSystemObject")
For Each drv In fso.Drives
driveInfo = drv.DriveLetter & ": - Typ: " & GetDriveTypeString(drv.driveType)
lstDrives.AddItem driveInfo
Next drv
Set fso = Nothing
End Sub
Function GetDriveTypeString(driveType As Integer) As String
Select Case driveType
Case 0: GetDriveTypeString = "0 - Unbekannt"
Case 1: GetDriveTypeString = "1 - Kein Stammverzeichnis"
Case 2: GetDriveTypeString = "2 - Wechseldatenträger"
Case 3: GetDriveTypeString = "3 - Festplatte"
Case 4: GetDriveTypeString = "4 - Netzlaufwerk"
Case 5: GetDriveTypeString = "5 - CD-ROM"
Case 6: GetDriveTypeString = "6 - RAM-Disk"
Case Else: GetDriveTypeString = "Unbekannter Typ"
End Select
End Function
Und dann schaue mal ob Dein WebDAV da schonmal dabei ist.
Holger
Danke Holger,
jetzt kommen wir der Sache scheinbar auf die Spur. Ich versuche mal einen Screenshot anzufügen. Da stimmt gar nix. Die WebDAV Laufwerke werden als Festplatte erkannt und die Festplatten als Wechseldatenträger. Das Laufwerk das als Netzlaufwerk erkannt wird gibt es gar nicht. A und W sind die WebDAV Laufwerke.
http://weihnachtsland.bplaced.net/screenshot.jpg
P.S. Zum einfügen bin ich scheinbar zu doof. Deshalb der Link als Text
Erstmal zum Thema hochlade
Gehe auf Antwort dann machen das Dreieck nach unten für Attachment auf. Nun ziehe die Datei in Feld und klicke auf hochladen. Sollte eigentlich ganz einfach sein.
Hast Du da mal einfach eine 3 raus gemacht? Was passiert dann?
If drv.DriveType = 4
Holger
Wenn das nicht hilft dann vielleicht so
Function GetWebDAVDriveLetter() As String
Dim fso As Object
Dim drv As Object
Dim webDAVPath As String
webDAVPath = "https://webdav.example.com/your/path"
Set fso = CreateObject("Scripting.FileSystemObject")
For Each drv In fso.Drives
If drv.DriveType = 3 Then
If InStr(1, drv.ShareName, webDAVPath, vbTextCompare) > 0 Then
GetWebDAVDriveLetter = drv.DriveLetter
Exit Function
End If
End If
Next drv
GetWebDAVDriveLetter = ""
Set fso = Nothing
End Function
Aufrufen so:
Sub TestWebDAVDrive()
Dim driveLetter As String
driveLetter = GetWebDAVDriveLetter()
If driveLetter <> "" Then
Debug.Print "WebDAV-Laufwerk gefunden: " & driveLetter & ":"
Else
Debug.Print "Kein passendes WebDAV-Laufwerk gefunden."
End If
End Sub
Debug.Print kannst Du natürlich auch durch MSGBOX ersetzen.
Holger
Danke für die Infor zum einfügen. Ich bin immer nur über die Schnellantwort gegangen. Da gibt es das nicht. Rest schau ich mir gleich an.
Geändert in: drv.driveType = 3
IsWebDAVDrive liefert immer noch False zurück.
TestWebDAVDrive liefert Kein passendes WebDAV-Laufwerk gefunden.
Ich raffs nicht ;D
Das hier
webDAVPath = "https://webdav.example.com/your/path"
hattest Du aber angepasst?
Holger
Öhm, ne. Hat mir keiner gesagt ;D
Aber auch jetzt nach Anpassung klappt es immer noch nicht.
Ich dachte das wäre ein Universalteil das grundsätzlich alles ausliest was mit http bzw. https beginnt ausliest. Weil ich das für mehrere Datenbanken einsetzen wollte die alle ein unterschiedliches Laufwerk verwenden.
Trotzdem schonmal danke für deine bisherige Mühe.
Hast Du denn eine eindeutige http Adresse? Vielleicht kann man das ja dann so lösen:
Function:
Function GetDriveLetterByHttpsLink(httpsLink As String) As String
Dim fso As Object
Dim drv As Object
Set fso = CreateObject("Scripting.FileSystemObject")
For Each drv In fso.Drives
If InStr(1, drv.ShareName, httpsLink, vbTextCompare) > 0 Then
GetDriveLetterByHttpsLink = drv.DriveLetter
Exit Function
End If
Next drv
GetDriveLetterByHttpsLink = ""
Set fso = Nothing
End Function
Aufruf: (hier wieder anpassen!!!) ;)
Sub TestGetDriveLetter()
Dim driveLetter As String
Dim httpsLink As String
httpsLink = "https://www.meinExample.de"
driveLetter = GetDriveLetterByHttpsLink(httpsLink)
If driveLetter <> "" Then
Debug.Print "Laufwerksbuchstabe für " & httpsLink & ": " & driveLetter & ":"
Else
Debug.Print "Kein passendes Laufwerk gefunden für: " & httpsLink
End If
End Sub
Versuch macht klug
Holger
Hallo Jörg,
kannst du mal bitte kurz erläutern, warum du den Laufwerksbuchstaben ermitteln möchtest? Ich kann darin noch keinen tieferen Sinn erkennen.
Knobbi38
Hallo Jörg, habe das ohne DriveType bei mir versucht und es hat geklappt. Nur musst Du halt die Verknüpfung eindeutig wissen.
Holger
@knobbi38 Weil sonst der FileCopy-Befehl in meiner Datensicherung fehlschlägt. Fehler 52 Dateiname oder Nummer falsch. Wenn ich den Laufwerksbuchstaben angebe (den ich ja kenne) funktioniert es.
@Debus Deine letzte Lösung werde ich mir am Dienstag anschauen. Vorher komme ich leider nicht mehr dazu.
Zitat von: Debus am Oktober 27, 2024, 11:47:01Function GetDriveTypeString(driveType As Integer) As String
Die Dokumentation listet von deinem Beispiel abweichende Werte für DriveType (https://learn.microsoft.com/en-us/office/vba/language/reference/user-interface-help/drivetype-property).
Hallo PhilS,
danke, die abweichende Liste war mir gerade nicht geläufig, aber es sollte auch ohne gehen wenn er die Verknüpfung genau kennt.
Aber die Liste werde ich auf jeden Fall mal bei mir abspeichern.
Gruß
Holger
Hallo Jörg,
ja ok, aber dazu brauchst du doch gar nicht den aktuellen Laufwerksbuchstaben. Weise selber temporär für die Aufgabe einen Laufwerksbuchstaben zu und abschließend hebst du das Mapping wieder auf. Dann bist du vollkommen unabhängig und einen freien Laufwerksbuchstaben wird es wohl immer geben.
Unabhängig davon kannst du dafür auch WinSCP verwenden, denn WebDAV ist nur ein Protokoll, was von WinSCP unterstützt wird.
Gruß
Ulrich
Danke an alle Helfer. Im besonderen mal wieder an Holger. Habe das Problem jetzt etwas anders gelöst. Nachdem die DriveList mit den richtigen Zahlen funktioniert verwende ich diese um den Laufwerksbuchstaben zuzuweisen.
Hallo Jörg,
kennst Du den die Laufwerksbezeichnungen von allen Usern? Wenn Ja dann frag doch den angemeldeten User ab und weise daraufhin den LW Buchstaben automatisch zu.
Function GetWindowsUser() As String
GetWindowsUser = Environ("USERNAME")
End Function
Holger
Hallo Holger,
ich bin doch der einzige User. Aber auf zwei PC. Bei der Datensicherung geht es darum den Datenbestand auf beiden Rechner über ein Netzlaufwerk zu aktualisieren.
Liebe Grüße
OK, dann kennst Du sicherlich die LW Bezeichnng der beiden Rechner. Wenn hier die LW wieder unterschiedlich sind, dann benutzer den Rechnernamen um die LW Bezeichnung zuzuordnen.
Function GetComputerName() As String
GetComputerName = Environ("COMPUTERNAME")
End Function
Holger
Hallo Holger,
sorry für die verspätete Antwort. Ich verstehe nicht ganz wie deine letzte Funktion bei meinem Problem helfen soll. Ich wollte doch nur die WebDAV die mit http beginnt automatisch gegen den Laufwerksbuchstaben austauschen.
Liebe Grüße
Ich dachte, wenn Du an verschiedenen Rechner sitzt, sind da ja, sonst wäre das vorherige ja unsinnig gewesen, unterschiedliche LW Bezeichnungen. Somit könntest Du das anhand des Rechnernamens auch automatisiert zuweisen.
Holger
Hallo,
der konkrete LW-Buchstabe ist doch vollkommen irrelevant. Ich erinnere nochmal an den Beitrag aus #21.