VBA to obtain Dropbox folder location into Excel

Mrsbex

New Member
Joined
Dec 5, 2017
Messages
12
Hi All,

I have a macro which worked beautifully on my PC to save a workbook to Dropbox. However, when a colleague tried to use it, it didn't work because Dropbox on their PC is not in the usual place. I have looked into obtaining the Dropbox directory from the json file but I don't know how to do it all automatically as it is beyond my skill-set.

This is my original macro which worked when the Dropbox folder is where it should be...

Code:
Sub SaveIt()
    Dim FName As String
    Dim Dboxdirectory As String
    
    Dboxdirectory = Environ("USERPROFILE") & "\Dropbox\ORDERS\To be processed\"
    FName = ThisWorkbook.Worksheets("Fashion").Range("D2").Value
    ActiveWorkbook.SaveAs Filename:=Dboxdirectory & FName & ".xlsm", FileFormat:=xlOpenXMLWorkbookMacroEnabled
    
End Sub
I tried recording a macro while inserting my info.json file into the workbook so I could pull the directory from the table it produces it to use in the above code, but of course, when I tried to edit it to look in the userprofile directory to obtain the json file on any PC it threw it's rattle out of it's pram and now I'm lost. What it does is see the Dim reference literally, and passes that across to the query builder instead of the path so it tries to add this path in the query "= Json.Document(File.Contents( JsonDir & "\info.json"))"

This is what I have tried...

Code:
Sub GetDropboxJson()


    Dim FName As String
    Dim JsonDir As String
    JsonDir = Environ("USERPROFILE") & "\AppData\Local\Dropbox"
    ActiveWorkbook.Queries.Add Name:="info", Formula:= _
        "let" & Chr(13) & "" & Chr(10) & "    Source = Json.Document(File.Contents( JsonDir & ""\info.json""))," & Chr(13) & "" & Chr(10) & "    #""Converted to Table"" = Record.ToTable(Source)" & Chr(13) & "" & Chr(10) & "in" & Chr(13) & "" & Chr(10) & "    #""Converted to Table"""
    ActiveWorkbook.Worksheets.Add
    With ActiveSheet.ListObjects.Add(SourceType:=0, Source:= _
        "OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location=info;Extended Properties=""""" _
        , Destination:=Range("$A$1")).QueryTable
        .CommandType = xlCmdSql
        .CommandText = Array("SELECT * FROM [info]")
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .PreserveColumnInfo = True
        .ListObject.DisplayName = "info"
    End With
End Sub
Please can someone help?

Thanks.
 

6StringJazzer

Active Member
Joined
Jan 27, 2010
Messages
410
Please try this. My own info.json file is only one line, so that's what I assumed for this solution. The Dropbox site shows it spread out over multiple lines, but that may be just to illustrate.

Code:
Sub SaveIt()
    Dim FName As String
    Dim Dboxdirectory As String
    
    Dboxdirectory = [COLOR=#FF0000]DropboxPath & "[/COLOR]\ORDERS\To be processed\"
    FName = ThisWorkbook.Worksheets("Fashion").Range("D2").Value
    ActiveWorkbook.SaveAs Filename:=Dboxdirectory & FName & ".xlsm", FileFormat:=xlOpenXMLWorkbookMacroEnabled
    
End Sub


' If there are multiple dropbox accounts on this machine, this will
' only get the first one
Public Function DropboxPath() As String

   Dim RegEx As Object
   Dim MatchColl As Object
   Dim DataLine As String
   Const FileNum = 1 ' Assumes no other files are open!!
   
   Set RegEx = CreateObject("VBScript.RegExp")
   RegEx.Global = True
   RegEx.IgnoreCase = False
   
   ' Open the Dropbox configuration file
   ' This is a JSON file that is human-readable
   ' The first line of the file has configuration for the first Dropbox account
   ' The first attribute is the path
   Open Environ("LOCALAPPDATA") & "\Dropbox\info.json" For Input As [URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=FileNum"]#FileNum[/URL] 
   
   Do While Not EOF(FileNum)
       Line Input [URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=FileNum"]#FileNum[/URL] , DataLine ' read in data 1 line at a time
       ' decide what to do with dataline,
       ' depending on what processing you need to do for each case
   Loop
   
   Close [URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=FileNum"]#FileNum[/URL] 

   RegEx.Pattern = "^.*""path"": ""([^""]*).*"

   DropboxPath = Replace(RegEx.Replace(DataLine, "$1"), "", "")

End Function

Public Sub Test()
   MsgBox "Dropbox path:" & vbCrLf & DropboxPath
End Sub
 
Last edited:

Mrsbex

New Member
Joined
Dec 5, 2017
Messages
12
Thanks 6StringJazzer it worked except for some reason it never changed the \\ to \ so I created a new sheet called DropboxPathResult and added the code below to an autoopen macro so it updates when the workbook is opened, no matter which computer it's on, and changes the \\ to \ at the same time.

Code:
Call DropboxPath    
    Sheets("DropboxPathResult").Activate
    ActiveSheet.Cells(1, 1).Select
    ActiveCell.FormulaR1C1 = "=DropboxPath()"
    Range("A1").Select
    Selection.Copy
    Range("A2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("A2").Select
    Cells.Replace What:="\\", Replacement:="\", LookAt:=xlPart, SearchOrder _
        :=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
Thank you so much for your help!
 

6StringJazzer

Active Member
Joined
Jan 27, 2010
Messages
410
When I run it I don't get any \\ just the single \ . I don't understand why you have to make that change.
 

Jon Peltier

MrExcel MVP
Joined
May 14, 2003
Messages
4,755
I added one line before the end of Function Dropboxpath():

Code:
Public Function DropboxPath() As String
   Dim RegEx As Object
   Dim MatchColl As Object
   Dim DataLine As String
   Const FileNum = 1 ' Assumes no other files are open!!
   
   Set RegEx = CreateObject("VBScript.RegExp")
   RegEx.Global = True
   RegEx.IgnoreCase = False
   
   ' Open the Dropbox configuration file
   ' This is a JSON file that is human-readable
   ' The first line of the file has configuration for the first Dropbox account
   ' The first attribute is the path
   Open Environ("LOCALAPPDATA") & "\Dropbox\info.json" For Input As [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=FileNum]#FileNum[/URL] 
   
   Do While Not EOF(FileNum)
       Line Input [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=FileNum]#FileNum[/URL] , DataLine  ' read in data 1 line at a time
       ' decide what to do with dataline,
       ' depending on what processing you need to do for each case
   Loop
   
   Close [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=FileNum]#FileNum[/URL] 

   RegEx.Pattern = "^.*""path"": ""([^""]*).*"

   DropboxPath = Replace(RegEx.Replace(DataLine, "$1"), "", "")

   DropboxPath = Replace(DropboxPath, "\", "") '' Change double to single backslash
End Function
 

Mrsbex

New Member
Joined
Dec 5, 2017
Messages
12
When I run it I don't get any \\ just the single \ . I don't understand why you have to make that change.
I don't know why yours and mine are different. When I look at the json file, it has \\ in the path. It's not a problem, the tweak worked for me. I appreciate the help, I'd never have got anywhere otherwise! Thank you :)
 

Mrsbex

New Member
Joined
Dec 5, 2017
Messages
12
DropboxPath = Replace(DropboxPath, "", "") '' Change double to single backslash
End Function[/CODE]
This is great, thanks, I've learned loads from this thread, and knowing how to do these things in VBA is really exciting (if you're me...) :LOL:
 

6StringJazzer

Active Member
Joined
Jan 27, 2010
Messages
410
I'm sorry for the confusion. I went back and looked at my working code and it is exactly like what Jon Peltier posted. I must have posted my code above before I was completely finished.
 

Forum statistics

Threads
1,084,749
Messages
5,379,617
Members
401,615
Latest member
syn_excel

Some videos you may like

This Week's Hot Topics

  • VBA code giving errors and stopping Excel
    Hello Experts, I have this code being used to loop through files in a file path, and copy specific data to another sheet. It is giving me several...
  • Disable MsgBox message
    Morning, I have a userform where if i leave a ComboBox empty i see a MsgBox warning me that i must enter an invoice number. It is this MsgBox i...
  • Macro Recorder into VBA, Copy Paste Data Filled Cells
    Hi Everyone, I have a macro recorder file that takes a selection of data, copies, then pastes into a new sheet on ("A2:B2") The issue is my...
  • Number format changes while pasting into a cell
    Hi, I am trying to paste a number 180204524303 from an email to an excel cell, however, whenever i try to do so , the the paste value appears as...
  • Collating data
    Hello all. Could someone please help. I am trying to pull all column data from multiple sheets (24 I total so far) into 1 master sheet without...
  • Sum Multiple Columns Based on Multiple Criteria
    I am trying to consolidate data by summing columns G through M based on material, plant, vendor, and fiscal year being identical. The period does...
Top