Creating a VBA script to automate data upload and transformation

Question

I'm processing data from a simulation. The monitors from the simulation are CSV files, but there are around 20 per simulation and it's cumbersome to upload each one in Excel and transform the values to decimal number type.

I currently have a VBA module that automates the upload of these values:

  '''  Sub Macro4()

ActiveWorkbook.Queries.Add Name:="oil-produced", Formula _
    := _
    "let" & Chr(13) & "" & Chr(10) & "    Source = Table.FromColumns({Lines.FromBinary(File.Contents(""C:\Users\user\Documents\run6\results\oil-produced.out""), null, null, 1252)})," & Chr(13) & "" & Chr(10) & "    #""Split Column by Delimiter"" = Table.SplitColumn(Source, ""Column1"", Splitter.SplitTextByDelimiter("" "", QuoteStyle.Csv), {""Column1.1"", ""C" & _
    "olumn1.2"", ""Column1.3""})," & Chr(13) & "" & Chr(10) & "    #""Changed Type"" = Table.TransformColumnTypes(#""Split Column by Delimiter"",{{""Column1.1"", type number}, {""Column1.2"", type number}, {""Column1.3"", type number}})" & Chr(13) & "" & Chr(10) & "in" & Chr(13) & "" & Chr(10) & "    #""Changed Type"""
ActiveWorkbook.Worksheets.Add
With ActiveSheet.ListObjects.Add(SourceType:=0, Source:= _
    "OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location=""oil-produced"";Extended Properties=""""" _
    , Destination:=Range("$A$1")).QueryTable
    .CommandType = xlCmdSql
    .CommandText = Array("SELECT * FROM [oil-produced]")
    .RowNumbers = False
    .FillAdjacentFormulas = False
    .PreserveFormatting = True
    .RefreshOnFileOpen = False
    .BackgroundQuery = True
    .RefreshStyle = xlInsertDeleteCells
    .SavePassword = False
    .SaveData = True
    .AdjustColumnWidth = True
    .RefreshPeriod = 0
    .PreserveColumnInfo = True
    .ListObject.DisplayName = "oil_produced"
    .Refresh BackgroundQuery:=False
End With
Application.Run "getUnits"
  End Sub

The data file is in the folder C:\Users\user\Documents\run6\results\oil-produced and the data file is called oil-produced.

I have to call several data files like this and the folder that the files are in changes. I would like to be able to parameterize the file folder and data file name at the beginning of the macro so that I can change the file location easily without correcting each query and create a for loop to loop through the data files so that the sub isn't as long and bulky.

I tried doing this by making the folder name a string and substituting that within the workbook query; however, I get an error saying that the supplied file path must be a valid absolute path.

Does anyone have any suggestions for alternate ways to do this?

Could you show us your attempt with the folder name as a string, please? It's possible a small "tweak" could help that. It sounds like the right approach... — Cindy Meister, Jan 21 '20 at 15:38

score 1 · Accepted Answer · answered Jan 21 '20 at 15:26

I don't know where you have your queries information so I setup a table to store it like this:

Table name: TableParams

Check the code comments and adjust it to fit your needs.

Code:

Option Explicit

Public Sub ProcessQueries()

    Dim sourceTable As ListObject
    Dim sourceListRow As ListRow

    Dim queryName As String
    Dim sourceFolder As String
    Dim sourceFileName As String
    Dim targetSheetName As String
    Dim targetCellAddr As String

    Set sourceTable = Range("TableParams").ListObject

    ' Loop through each row
    For Each sourceListRow In sourceTable.ListRows


        queryName = sourceListRow.Range.Cells(1, 1).Value ' -> ' Second argument of cells is the table's column number
        sourceFolder = sourceListRow.Range.Cells(1, 2).Value
        sourceFileName = sourceListRow.Range.Cells(1, 3).Value
        targetSheetName = sourceListRow.Range.Cells(1, 4).Value
        targetCellAddr = sourceListRow.Range.Cells(1, 5).Value

        OutputQuery queryName, sourceFolder, sourceFileName, targetSheetName, targetCellAddr

    Next sourceListRow


End Sub

Private Sub OutputQuery(ByVal queryName As String, ByVal sourceFolder As String, _
                        ByVal sourceFileName As String, ByVal targetSheetName As String, ByVal targetCellAddr As String)

    Dim targetSheet As Worksheet
    Dim sourceQueryFormula As String

    sourceQueryFormula = "let" & Chr(13) & "" & Chr(10) & "    " & _
                         "Source = Table.FromColumns({Lines.FromBinary(" & _
                         "File.Contents(" & Chr(34) & sourceFolder & "\" & sourceFileName & Chr(34) & ")" & _
                         ", null, null, 1252)})," & Chr(13) & "" & Chr(10) & "    #""Split Column by Delimiter"" = Table.SplitColumn(Source, ""Column1"", Splitter.SplitTextByDelimiter("" "", QuoteStyle.Csv), {""Column1.1"", ""C" & _
                         "olumn1.2"", ""Column1.3""})," & Chr(13) & "" & Chr(10) & "    #""Changed Type"" = Table.TransformColumnTypes(#""Split Column by Delimiter"",{{""Column1.1"", type number}, {""Column1.2"", type number}, {""Column1.3"", type number}})" & Chr(13) & "" & Chr(10) & "in" & Chr(13) & "" & Chr(10) & "    #""Changed Type"""

    ' Delete previous query if exists
    On Error Resume Next
    ThisWorkbook.Queries(queryName).Delete
    On Error GoTo 0

    ' Change to use thisworkbook instead of active workbook
    ThisWorkbook.Queries.Add Name:=queryName, Formula:=sourceQueryFormula

    ' Add new worksheet and change it's name
    If Not WorksheetExists(targetSheetName) Then
        Set targetSheet = ThisWorkbook.Worksheets.Add
        targetSheet.Name = targetSheetName
    Else
        Set targetSheet = ThisWorkbook.Worksheets(targetSheetName)
    End If

    With targetSheet.ListObjects.Add(SourceType:=0, source:= _
                                     "OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location=" & queryName & ";Extended Properties=""""" _
                                     , destination:=targetSheet.Range(targetCellAddr)).QueryTable
        .CommandType = xlCmdSql
        .CommandText = Array("SELECT * FROM [" & queryName & "]")
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .PreserveColumnInfo = True
        .ListObject.DisplayName = queryName
        .Refresh BackgroundQuery:=False
    End With

    ' Next line don't need Application.Run if your calling the macro in the same book
    'Application.Run "getUnits"
    getUnits

End Sub

Private Function WorksheetExists(shtName As String, Optional wb As Workbook) As Boolean
' Credits: https://stackoverflow.com/a/6688482/1521579
    Dim sht As Worksheet

    If wb Is Nothing Then Set wb = ThisWorkbook
    On Error Resume Next
    Set sht = wb.Sheets(shtName)
    On Error GoTo 0
    WorksheetExists = Not sht Is Nothing
End Function

Let me know if it works

score 0 · Answer 2 · answered Jan 21 '20 at 14:27

I would try something like so, if I get you.

Function CompleteString(strPath As String, strFileName As String, _
                    Optional blnAdditionalQuotes = True)
    CompleteString = IIf(blnAdditionalQuotes, Chr(34), vbNullString) & _
                        "\" & strFileName & _
                        IIf(blnAdditionalQuotes, Chr(34), vbNullString)
End Function

and then use like so

......"File.Contents(" & CompleteString ("C:\Users\user\Documents\run6\results\oil-produced","Oil Produced.out") & "),null, null"...….

Creating a VBA script to automate data upload and transformation

2 Answers2