How to run personal.xlsb macro using vbscript to export data to mysql

Question

How do I run personal.xlsb (MS Excel) code to transport data to mysql?

I get blank rows.

This code seems to not work since active sheet here keeps referring to my personal.xlsb and not the other Excel file containing the data that I am planning to export the data with, as both Excel files (data & personal.xlsb) are open at the same time.

Public Sub Insert_Testing()
Dim con as adodb.connection
Dim lastrow as long
Set ws = ThisWorkbook.ActiveSheet
Set con = New Adodb.connection
Con.open = "Provider=MSDASQL.1;Data Source=MySQL_db;"
Dim rng as range
Lastrow = ws.Range("B" & Rows.count).End(x1Up).row
Set rng = ws.Range("A2:G" & Lastrow)
Dim row as range

For each row in rng.rows
    SQL = "Insert into skynet_msa.ALU_testing (Area, Min_C, Max_C, Avg_C, Emis, Ta_C, Area_Px) values ('" & row.Cells(1).Value & "', '" & row.Cells(2).Value & "', '" & row.Cells(3).Value & "', '" & row.Cells(4).Value & "', '" & row.Cells(5).Value & "', '" & row.Cells(6).Value & "', '" & row.Cells(7).Value &"');"
    Con.Execute SQL
Next row

Con.close

MsgBox "Done"

End Sub

vbscript code:

sPath = "H:\msa\Temp\MengKeat\FlukeReport\20220429\CV4T1L2.11\testing1"

Set oFSO = CreateObject("Scripting.FileSystemObject")

sNewestFile = GetNewestFile(sPath)

If sNewestFile <> "" Then
    WScript.Echo "Newest file is " & sNewestFile
    dFileModDate = oFSO.GetFile(sNewestFile).DateLastModified
    If DateDiff("h", dFileModDate, Now) > 1 Then
    End If
Else
    WScript.Echo "Directory is empty"
End If

Function GetNewestFile(ByVal sPath)

sNewestFile = Null ' init value

Set oFSO = CreateObject("Scripting.FileSystemObject")
Set oFolder = oFSO.GetFolder(sPath)
Set oFiles = oFolder.Files

For Each oFile In oFiles
    On Error Resume Next
    If IsNull(sNewestFile) Then
        sNewestFile = oFile.Path
        dPrevDate = oFile.DateLastModified
    Elseif dPrevDate < oFile.DateLastModified Then
        sNewestFile = oFile.Path
    End If
    On Error Goto 0
Next

If IsNull(sNewestFile) Then sNewestFile = ""

    GetNewestFile = sNewestFile

    ExcelFilePath = sNewestFile

    MacroPath = "C:\Users\gsumarlin\AppData\Roaming\Microsoft\Excel\XLSTART\PERSONAL.XLSB"

    MacroName = "PERSONAL.XLSB!Module1.Insert_Testing"

    Set ExcelApp = CreateObject("Excel.Application")

    ExcelApp.Visible = "False"

    ExcelApp.DisplayAlerts = False

    Set wb = ExcelApp.Workbooks.Open(ExcelFilePath)

    ExcelApp.Application.Visible = True
  
    Set mac = ExcelApp.Workbooks.Open(MacroPath)

    ExcelApp.Run MacroName

    wb.Save

    ExcelApp.DisplayAlerts = True

    MsgBox "Your Automated Task successfully ran at " & TimeValue(Now), vbInformation

    oFSO.DeleteFile sNewestFile
    Set oFSO = Nothing  

End Function

Answer 1

I would do something like this: put this in your personal.xlsb

'given a folder path, find the latest file and insert the contents
'  of the first worksheet to a DB
Sub ProcessLatestFile(fldr As String)
    Dim wb As Workbook, lastFile As Object
    
    Set lastFile = LatestFile(fldr)        'find the last-modified file
    Debug.Print "Latest file:" & lastFile.Path
    If lastFile Is Nothing Then Exit Sub   'no files in folder
    Set wb = Workbooks.Open(lastFile.Path) 'open the file
    InsertData wb.Worksheets(1)            'insert the data
    wb.Close False                         'close the workbook
    MsgBox "Done"
End Sub

Sub InsertData(ws As Worksheet)
    
    Const SQL As String = "Insert into skynet_msa.ALU_testing (Area, Min_C, Max_C, Avg_C, Emis, " & _
                          "Ta_C, Area_Px) values('{1}','{2}','{3}','{4}','{5}','{6}','{7}')"
    
    Dim con As ADODB.Connection, row As Range
    Dim lastrow As Long, rng As Range, i As Long, s As String
    
    Set con = New ADODB.Connection
    con.Open "Provider=MSDASQL.1;Data Source=MySQL_db;"
    
    lastrow = ws.Range("B" & ws.Rows.Count).End(xlUp).row
    
    If lastrow = 1 Then
        MsgBox "No data to insert!"
        Exit Sub
    End If
    
    For Each row In ws.Range("A2:G" & lastrow).Rows
        s = SQL
        For i = 1 To 7 'build the SQL
            s = Replace(s, "{" & i & "}", row.Cells(i).Value)
        Next i
        con.Execute s
    Next row
    con.Close
End Sub

Function LatestFile(fldr As String) As Object
    Dim fso As Object, f As Object, fLatest As Object, fDt
    
    Set fso = CreateObject("scripting.filesystemobject")
    fDt = 0
    For Each f In fso.getfolder(fldr).Files
        Debug.Print f.Name
        If f.datelastmodified > fDt Then
            Set fLatest = f
            fDt = f.datelastmodified
        End If
    Next f
    Set LatestFile = fLatest
End Function

Then in your vbscript all you need to do is launch Excel, open up personal.xlsb, and call the macro ProcessLatestFile, passing in the folder path to search in as an argument. Pass dynamic parameters to Application.Run in VBA - Error 449 argument not optional error shows how to pass an argument with Run