'THIS REQUIRES A REFERENCE TO MICROSOFT XML, V2.6 OR HIGHER
'In VBA, go to Tools, References, then select the Microsoft XML from the list
'store the folder as a variable so you don't have to recheck it each time
Public strDropBoxFolder As String
'This locates and returns the full path of the DropBox folder
Public Function DropBoxFolder() As String
Dim DBhost As String
Dim strInput As String
Dim DBPath As String
On Error GoTo Error_Handler
'If the folder has already been found, don't recheck it, just use the stored variable
If strDropBoxFolder <> "" Then
DropBoxFolder = strDropBoxFolder
Exit Function
End If
'otherwise, go find it.
' find the host.db file
DBhost = CStr(Environ("USERPROFILE") & "\AppData\Roaming\Dropbox\host.db")
If Dir(DBhost) <> "" Then
Open DBhost For Input Access Read As #1
'read the host.db file
Line Input #1, strInput
Close #1
'decode from Base64
strInput = StrConv(DecodeBase64(strInput), vbUnicode)
'ignore the first line and extract the file path by looking drive name such as C:\
DBPath = Mid(strInput, InStr(strInput, ":\") - 1)
'return the result
DropBoxFolder = DBPath
'store the result for future use
strDropBoxFolder = DBPath
Else
'file not found and error are handled the same way
Error_Handler:
On Error Resume Next
strDropBoxFolder = ""
End If
End Function
Private Function DecodeBase64(ByVal strData As String) As Byte()
Dim objXML As MSXML2.DOMDocument
Dim objNode As MSXML2.IXMLDOMElement
' help from MSXML
Set objXML = New MSXML2.DOMDocument
Set objNode = objXML.createElement("b64")
objNode.DataType = "bin.base64"
objNode.Text = strData
DecodeBase64 = objNode.nodeTypedValue
' thanks, bye
Set objNode = Nothing
Set objXML = Nothing
End Function