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