如何使用vbscript成功运行personal.xlsb宏以将数据导出到mysql

Question

Can someone help me to check whether this set of code is correct to be run on personal.xlsb (MS Excel) and can fully transport the data to mysql? This is because I keep getting blank rows when I execute such code. This code below 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 opened 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

Below here is my 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