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