Insert current Excel workbook name in to a text file-CodePudding

I need to export the current Workbook's name to a specific line/place in a text file using a Macro/VBA Code.

I have Workbooks where the calculations are done externally with Python. Python uses one config.json file as reference as to which Excel file to do the calculations on.

Every time I want to do calculations on a different workbook I have to manually change the Excel file name in the config.json file. The config.jason file is in a different Dir than the Excel file.

The Excel file name needs to go in to the "input_file line in the config.jason file "input_file": "D:\Temp\workbook_name.xlsm"

config.jason file sample content.

{
    "columns": {
        "Date": "Date",
        "Product Description": "Description",
        "Category": "Category",
        "ID": "ID",
        "Views": "Stock",
        "PM": "SUMIF",
        "Active Until": "Until",
        "Item Decription": "DES",
        "Item Category": "CAT",
    },
    "input_file": "D:\\Temp\\workbook_name.xlsm"
}

CodePudding user response：

Build the JSON string and use a FileSystemObject to create the text file.

Option Explicit
Sub CreateJSON()

    Const JSONFILE = "config.json"
    Const FOLDER = "path-to-config.json"
    Const NL = vbCrLf & "    " ' new line
    
    Dim dict As Object, k
    Dim json As String, filename As String, comma As String
    Set dict = CreateObject("Scripting.Dictionary")
    
    ' config
    dict.Add "Date", "Date"
    dict.Add "Product Description", "Description"
    dict.Add "Category", "Category"
    dict.Add "ID", "ID"
    dict.Add "Views", "Stock"
    dict.Add "PM", "SUMIF"
    dict.Add "Active Until", "Until"
    dict.Add "Item Decription", "DES"
    dict.Add "Item Category", "CAT"

    ' filename unix for python
    filename = Replace(ThisWorkbook.FullName, "\", "/")
    
    ' build json string
    json = "{" & NL & """columns"": {"
    For Each k In dict.keys
        json = json & comma & NL & "    """ & k & """: """ & dict(k) & """"
        comma = ","
    Next
    json = json & NL & "}," & NL & """input_file"": """ & filename & """" & vbCrLf & "}"
    
    ' write file
    Dim FSO As Object, ts As Object
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set ts = FSO.CreateTextFile(FOLDER & JSONFILE)
    ts.write json
    ts.Close
    
    MsgBox JSONFILE & " created in " & FOLDER, vbInformation

End Sub

CodePudding user response：

In cell A1:

{
    "columns": {
        "Date": "Date",
        "Product Description": "Description",
        "Category": "Category",
        "ID": "ID",
        "Views": "Stock",
        "PM": "SUMIF",
        "Active Until": "Until",
        "Item Decription": "DES",
        "Item Category": "CAT",
    },
    "input_file": "<file>"
}

Code to replace token and create/overwrite json file:

Sub RefreshJson()

    PutContent "C:\temp\config.json", _
               Replace(Sheet1.Range("A1").Value, "<file>", _
                       Replace(ActiveWorkbook.FullName, "\", "\\"))

End Sub


'create/overwrite a text file at location `f` using `content`
Sub PutContent(f As String, content As String)
    CreateObject("scripting.filesystemobject"). _
                  opentextfile(f, 2, True).write content
End Sub