Retrieve the Dropbox folder
? Global_GetDropboxFolder()
? Global_GetDropboxFolder()
Code:
Option Explicit
Public Function Global_GetDropboxFolder() As String
' #VBIDEUtils#************************************************************
' * Author :
' * Web Site :
' * E-Mail :
' * Date : 10/16/2015
' * Time : 10:09
' * Module Name : Lib_Module
' * Module Filename : Lib.bas
' * Procedure Name : Global_GetDropboxFolder
' * Purpose :
' * Parameters :
' * Purpose :
' **********************************************************************
' * Comments :
' *
' *
' * Example :
' *
' * See Also :
' *
' * History :
' *
' *
' **********************************************************************
' #VBIDEUtilsERROR#
On Error GoTo ERROR_Global_GetDropboxFolder
Dim sFile As String
Dim sFolder As String
sFolder = vbNullString
sFile = AddBackslash(Environ("userprofile")) & "AppData\Local\DropBox\info.json"
If FileExist(sFile) Then
sFile = ReadFile(AddBackslash(Environ("userprofile")) & "AppData\Local\DropBox\info.json")
sFolder = GetStringBetweenTags(sFile, """path"": """, """")
End If
EXIT_Global_GetDropboxFolder:
On Error Resume Next
Global_GetDropboxFolder = sFolder
Exit Function
' #VBIDEUtilsERROR#
ERROR_Global_GetDropboxFolder:
Resume EXIT_Global_GetDropboxFolder
End Function
Public Function AddBackslash(ByVal sPath As String, Optional ByVal sChar As String = "\") As String
' #VBIDEUtils#***********************************************************
' * Author :
' * Web Site :
' * E-Mail :
' * Date : 02/26/2003
' * Project Name :
' * Module Name : Files_Module
' * Module Filename : Files.bas
' * Procedure Name : AddBackslash
' * Purpose : AddBackslash - Append a backslash to a path if needed
' * Parameters :
' * ByVal sPath As String
' * Optional ByVal sChar As String = "\"
' **********************************************************************
' * Comments :
' * Append a backslash (or any character) at the end of a path
' * if it isn't there already
' *
' * Example :
' *
' * Screenshot :
' *
' * See Also :
' *
' * History :
' *
' *
' **********************************************************************
AddBackslash = sPath
If LenB(sPath) > 0 Then
If Right$(sPath, 1) <> sChar Then
AddBackslash = sPath & sChar
End If
End If
End Function
Public Function FileExist(sFile As String) As Boolean
' #VBIDEUtils#***********************************************************
' * Programmer Name :
' * Web Site :
' * E-Mail :
' * Date : 04/11/1999
' * Time : 16:53
' * Module Name : Files_Module
' * Module Filename : Files.bas
' * Procedure Name : FileExist
' * Parameters :
' * sFile As String
' **********************************************************************
' * Comments :
' *
' *
' **********************************************************************
On Error Resume Next
Dim oFSO As Object
Set oFSO = CreateObject("Scripting.FileSystemObject")
If oFSO.FileExists(sFile) Then
FileExist = True
Else
FileExist = False
End If
Set oFSO = Nothing
End Function
Public Function GetStringBetweenTags(ByVal sSearchIn As String, ByVal sFrom As String, ByVal sUntil As String, Optional nPosAfter As Long, Optional ByVal nStartAtPos As Long = 0) As String
' #VBIDEUtils#***********************************************************
' * Programmer Name :
' * Web Site :
' * E-Mail :
' * Date : 01/15/2001
' * Time : 13:31
' * Module Name : Lib_Module
' * Module Filename : Lib.bas
' * Procedure Name : GetStringBetweenTags
' * Parameters :
' * ByVal sSearchIn As String
' * ByVal sFrom As String
' * ByVal sUntil As String
' * Optional nPosAfter As Long
' * Optional ByVal nStartAtPos As Long = 0
' **********************************************************************
' * Comments :
' * This function gets in a string and two keywords
' * and returns the string between the keywords
' *
' **********************************************************************
Dim nPos1 As Long
Dim nPos2 As Long
Dim nPos As Long
Dim nLen As Long
Dim sFound As String
Dim nLenFrom As Long
On Error GoTo ERROR_GetStringBetweenTags
nLenFrom = Len(sFrom)
nPos1 = InStr(nStartAtPos + 1, sSearchIn, sFrom, vbTextCompare)
nPos2 = InStr(nPos1 + nLenFrom, sSearchIn, sUntil, vbTextCompare)
If (nPos1 = 0) Or (nPos2 = 0) Then
sFound = vbNullString
Else
nPos = nPos1 + nLenFrom
nLen = nPos2 - nPos
sFound = Mid$(sSearchIn, nPos, nLen)
End If
GetStringBetweenTags = sFound
If nPos + nLen > 0 Then
nPosAfter = (nPos + nLen) - 1
End If
Exit Function
ERROR_GetStringBetweenTags:
GetStringBetweenTags = vbNullString
End Function
Public Function ReadFile(sFileSource As String) As String
' #VBIDEUtils#************************************************************
' * Author :
' * Web Site :
' * E-Mail :
' * Date : 01/15/2001
' * Time : 17:15
' * Module Name :
' * Module Filename :
' * Procedure Name : ReadFile
' * Purpose :
' * Parameters :
' * sFileSource As String
' * Purpose :
' **********************************************************************
' * Comments :
' *
' *
' * Example :
' *
' * See Also :
' *
' * History :
' *
' *
' **********************************************************************
Dim oFSO As Object
Set oFSO = CreateObject("Scripting.FileSystemObject")
ReadFile = oFSO.OpenTextFile(sFileSource).ReadAll
End Function