Results 1 to 8 of 8

Thread: VBA to obtain Dropbox folder location into Excel

  1. #1
    New Member Mrsbex's Avatar
    Join Date
    Dec 2017
    Location
    Devon, UK
    Posts
    12
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default VBA to obtain Dropbox folder location into Excel

    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.

  2. #2
    Board Regular 6StringJazzer's Avatar
    Join Date
    Jan 2010
    Location
    Tysons Corner VA, USA
    Posts
    233
    Post Thanks / Like
    Mentioned
    2 Post(s)
    Tagged
    0 Thread(s)

    Default Re: VBA to obtain Dropbox folder location into Excel

    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 = DropboxPath & "\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 #FileNum 
       
       Do While Not EOF(FileNum)
           Line Input #FileNum , 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 #FileNum 
    
       RegEx.Pattern = "^.*""path"": ""([^""]*).*"
    
       DropboxPath = Replace(RegEx.Replace(DataLine, "$1"), "", "")
    
    End Function
    
    Public Sub Test()
       MsgBox "Dropbox path:" & vbCrLf & DropboxPath
    End Sub
    Last edited by 6StringJazzer; Jan 25th, 2019 at 10:31 AM. Reason: Used LOCALAPPDATA to make more robust
    Making the world a better place one fret at a time | | |會 |會 |會 |會 | |:| | |會 |會

    Use CODE tags to preserve code formatting
    [code]
    ' Your code here
    [/code]

  3. #3
    New Member Mrsbex's Avatar
    Join Date
    Dec 2017
    Location
    Devon, UK
    Posts
    12
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: VBA to obtain Dropbox folder location into Excel

    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!

  4. #4
    Board Regular 6StringJazzer's Avatar
    Join Date
    Jan 2010
    Location
    Tysons Corner VA, USA
    Posts
    233
    Post Thanks / Like
    Mentioned
    2 Post(s)
    Tagged
    0 Thread(s)

    Default Re: VBA to obtain Dropbox folder location into Excel

    When I run it I don't get any \\ just the single \ . I don't understand why you have to make that change.

  5. #5
    MrExcel MVP
    Join Date
    May 2003
    Location
    USA
    Posts
    4,671
    Post Thanks / Like
    Mentioned
    5 Post(s)
    Tagged
    1 Thread(s)

    Default Re: VBA to obtain Dropbox folder location into Excel

    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 #FileNum 
       
       Do While Not EOF(FileNum)
           Line Input #FileNum , 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 #FileNum 
    
       RegEx.Pattern = "^.*""path"": ""([^""]*).*"
    
       DropboxPath = Replace(RegEx.Replace(DataLine, "$1"), "", "")
    
       DropboxPath = Replace(DropboxPath, "\", "") '' Change double to single backslash
    End Function
    Jon Peltier
    Peltier Technical Services, Inc.
    Try Peltier Tech Charts for Excel

  6. #6
    New Member Mrsbex's Avatar
    Join Date
    Dec 2017
    Location
    Devon, UK
    Posts
    12
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: VBA to obtain Dropbox folder location into Excel

    Quote Originally Posted by 6StringJazzer View Post
    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

  7. #7
    New Member Mrsbex's Avatar
    Join Date
    Dec 2017
    Location
    Devon, UK
    Posts
    12
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: VBA to obtain Dropbox folder location into Excel

    Quote Originally Posted by Jon Peltier View Post
    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...)

  8. #8
    Board Regular 6StringJazzer's Avatar
    Join Date
    Jan 2010
    Location
    Tysons Corner VA, USA
    Posts
    233
    Post Thanks / Like
    Mentioned
    2 Post(s)
    Tagged
    0 Thread(s)

    Default Re: VBA to obtain Dropbox folder location into Excel

    I'm sorry for the confusion. I went back and looked at my working code and it is exactly like what [COLOR=#49644E]Jon Peltier posted. I must have posted my code above before I was completely finished.

Some videos you may like

User Tag List

Tags for this Thread

Like this thread? Share it with others

Like this thread? Share it with others

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •