====== Dropbox ====== \\ Es kann sinnvoll sein, Bilder oder andere Dateien in den lokalen Dropbox-Ordner zu kopieren. Die folgende Funktion ermittelt den Pfad zum lokalen Dropbox-Ordner.\\ Function DropBoxPfad ' ermittelt den lokalen Pfad des DropBox-Ordners ' wird keine Dropbox-Installation gefunden, wird ein leerer String zurück gegeben ' kgsoft 160802 Dim WshShell Dim fso Const ForReading = 1, ForWriting = 2 Dim AppDataPfad Dim aktOrdner Dim DropInfo Dim f Dim DropInfoText ' Systemordner Appdata ermitteln Set WshShell = CreateObject ("WScript.Shell") Set fso = CreateObject("Scripting.FileSystemObject") AppDataPfad = WshShell.Environment("Process")("APPDATA") aktOrdner = Right(AppDataPfad, Len (AppDataPfad) - InStrRev(AppDataPfad, "\",-1, 1)) if aktOrdner <> "AppData" Then ' aktueller Ordner ist Roaming oder Local oder LocalLow AppDataPfad = Left(AppDataPfad, InStrRev(AppDataPfad, "\",-1, 1)) ' AppDataPfad auf \appdata\ setzen End If ' Standort info.json ermitteln If fso.FileExists(AppDataPfad & "Roaming\Dropbox\info.json") Then DropInfo = AppDataPfad & "Roaming\Dropbox\info.json" end If If fso.FileExists(AppDataPfad & "Local\Dropbox\info.json") Then DropInfo = AppDataPfad & "Local\Dropbox\info.json" end If If fso.FileExists(AppDataPfad & "LocalLow\Dropbox\info.json") Then DropInfo = AppDataPfad & "LocalLow\Dropbox\info.json" end If if DropInfo <> "" Then ' Ermittlung Dropbox-Pfad aus der info.json ' Annahme: Pfad steht nach dem String "path" zwischen dem folgenden beiden Anführungszeichen Set f = fso.OpenTextFile(DropInfo, ForReading) DropInfoText = f.ReadAll ' schrittweises Vorgehen, um evtl. individuelle Abweichungen abzufangen DropInfoText = Right(DropInfoText, Len (DropInfoText) - InStr(1, DropInfoText, "path", 1)-4) 'linken Teil bis path" abschneiden DropInfoText = Right(DropInfoText, Len (DropInfoText) - InStr(1,DropInfoText, Chr(34), 1)) 'linken Teil bis nächstes " abschneiden DropBoxPfad = Left(DropInfoText, InStr(1,DropInfoText, Chr(34), 1)-1) 'linken Teil bis nächstes " retten DropBoxPfad = Replace (DropBoxPfad, "\\", "\") ' doppelte \\ durch einfache \ ersetzen set fso = nothing set WshShell = nothing Else ' keine Dropbox gefunden set fso = nothing set WshShell = nothing DropBoxPfad = "" End If End Function