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

Question

谁能帮我看看这组代码在personal.xlsb (MS Excel) 上是否正确运行并且可以完全传输数据到 mysql？这是因为当我执行这样的代码时，我不断得到空白行。下面的代码似乎不起作用，因为这里的 active sheet 一直指的是我的 personal.xlsb 而不是另一个包含我计划导出数据的数据的 excel 文件，因为两者 excel个文件（数据&personal.xlsb）同时打开

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 代码：

sPath = "H:\msa\Temp\MengKeat\FlukeReport220429\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

我会做这样的事情：把这个放在你的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

然后在您的 vbscript 中，您需要做的就是启动 Excel，打开 personal.xlsb，然后调用宏 ProcessLatestFile，传入要搜索的文件夹路径作为争论。显示如何使用 Run

传递参数

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

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

mysql

vbscript

excel

vba