VBA 遍历 Excel 插入MySql

遍历读取指定目录下（含子级目录）的 Excel ，并插入 MySql

Sub Begin()

   Dim rootPath As String
    'With Application.FileDialog(msoFileDialogFolderPicker)
    '    If .Show Then rootPath = .SelectedItems(1) Else Exit Sub
    'End With
   rootPath = "D:\ExcelFiles\"

   Set fso = CreateObject("Scripting.FileSystemObject")
   For Each f In fso.GetFolder(rootPath).SubFolders ' 遍历子目录
       Call ListFolders(rootPath & "\" & f.Name, f.Name)
   Next
   'MsgBox "处理完成"

End Sub

Sub BeginSub()

   Dim rootPath As String
    With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show Then rootPath = .SelectedItems(1) Else Exit Sub
    End With
 
   ' Application.ScreenUpdating = False
   ' Application.DisplayAlerts = False
   Set fso = CreateObject("Scripting.FileSystemObject")
   For Each f In fso.GetFolder(rootPath).SubFolders ' 遍历子目录
       Call ListFolders(rootPath & "\" & f.Name, "浙江万胜")
   Next
   'Call ListFolders(rootPath, "正泰")
   MsgBox "处理完成"
   ' Application.ScreenUpdating = True
   ' Application.DisplayAlerts = True
End Sub

Function ListFolders(basePath, filterKey)
   If Right(basePath, 1) <> "\" Then basePath = basePath & "\"
   ' 读取目录下的 Excel
   Dim File As String
   Dim sourceWorkbook As Workbook
   Dim sourceSheet As Worksheet
   File = Dir(basePath & "*.xlsx")
   
        Application.ScreenUpdating = False
        Application.DisplayAlerts = False
    
   'Set targetWorkbook = Workbooks.Add
   'Set targetSheet = targetWorkbook.Worksheets(1)
    
    Do While File <> ""
    
        Application.ScreenUpdating = False
        Application.DisplayAlerts = False

        Set sourceWorkbook = Workbooks.Open(basePath & File)
        'Set sourceSheet = sourceWorkbook.Worksheets(1)
        'lastRow = sourceSheet.UsedRange.Rows.Count
        'sourceSheet.ShowAllData '清除筛选，显示全部
        'sourceSheet.Columns.Hidden = False '取消所有列的隐藏
        'sourceSheet.UsedRange.AutoFilter Field:=27, Criteria1:="*" & filterKey & "*"
        'sourceSheet.UsedRange.AutoFilter _
        'Field:=27, _
        'Criteria1:="*盛帆*", _
        'Operator:=xlAnd
        'sourceSheet.UsedRange.AutoFilter _
        'Field:=27, _
        'Criteria1:="*盛帆*"
        
        'Selection.AutoFilter
 
        'lastRow = sourceSheet.UsedRange.Rows.Count
        

        'sourceSheet.UsedRange.Copy targetSheet.Cells(1, 1)
        'lastRow = targetSheet.UsedRange.Rows.Count
        
        'Call Write2Mysql(targetSheet)
        For Each ws In sourceWorkbook.Worksheets
            Call Write2Mysql2(ws, filterKey)
        Next
        
       ' targetSheet.Cells.ClearContents
        
        sourceWorkbook.Close SaveChanges:=False
        Set sourceWorkbook = Nothing
        
        File = Dir '找寻下一个excel文件
        
        Application.ScreenUpdating = True
        Application.DisplayAlerts = True
    Loop
    
   ' targetWorkbook.Close SaveChanges:=False
   ' Set targetWorkbook = Nothing

       
   Set fso = CreateObject("Scripting.FileSystemObject")
   For Each f In fso.GetFolder(basePath).SubFolders ' 遍历子目录
      Call ListFolders(basePath & f.Name, filterKey)
   Next
   

   
End Function

Function Write2Mysql(sheet)
    '请先添加引用：工具－引用－Microsoft ActiveX Data Objects 2.8 'Library,Microsoft ActiveX Data Objects Recordset 2.8 Library
    Dim con As New ADODB.Connection
    Dim Sql As String
    Dim lastRow As Long
       
    
    con.ConnectionString = "Driver={MySQL ODBC 8.0 Unicode Driver};Server=127.0.0.1;DB=kettle;UID=root;PWD=mysqlroot;OPTION=3;"
    con.Open
    'MsgBox ("连接成功！" & vbCrLf & "数据库状态：" & con.State & vbCrLf & "数据库版本：" & con.Version)
    
    lastRow = sheet.Cells(Rows.Count, "A").End(xlUp).row


    For i = 2 To lastRow

        Sql = "INSERT INTO dnb_zysj_3xxxxxxx (GDJ, GDDW, TQ, XL, YHBH, YHMC, YDDZ, YHLB, CJZD, ZCBH, JLDBH, SBLB, SBLX, SBMC, CCBH, SJRQ, JDRY, TYRQ, DHPC, TYNX, CCRQ, SBXH, EDDY, EDDL, ZQD, SCCJ, CS, MYLX, JLFS, JLWZ, JLDDZ, TXDZ, BTL, TXMKLX, DBBB_CJ, MYLX_CJ, TXMKLX_CJ) VALUES (" _
                & "'" & V(sheet, i, 2) & "','" & V(sheet, i, 3) & "','" & V(sheet, i, 4) & "'," _
                & "'" & V(sheet, i, 5) & "','" & V(sheet, i, 6) & "','" & V(sheet, i, 7) & "'," _
                & "'" & V(sheet, i, 8) & "','" & V(sheet, i, 9) & "','" & V(sheet, i, 10) & "'," _
                & "'" & V(sheet, i, 11) & "','" & V(sheet, i, 12) & "','" & V(sheet, i, 13) & "'," _
                & "'" & V(sheet, i, 14) & "','" & V(sheet, i, 15) & "','" & V(sheet, i, 16) & "'," _
                & "'" & V(sheet, i, 17) & "','" & V(sheet, i, 18) & "','" & V(sheet, i, 19) & "'," _
                & "'" & V(sheet, i, 20) & "','" & V(sheet, i, 21) & "','" & V(sheet, i, 22) & "'," _
                & "'" & V(sheet, i, 23) & "','" & V(sheet, i, 24) & "','" & V(sheet, i, 25) & "'," _
                & "'" & V(sheet, i, 26) & "','" & V(sheet, i, 27) & "','" & V(sheet, i, 28) & "'," _
                & "'" & V(sheet, i, 29) & "','" & V(sheet, i, 30) & "','" & V(sheet, i, 31) & "'," _
                & "'" & V(sheet, i, 32) & "','" & V(sheet, i, 33) & "','" & V(sheet, i, 34) & "'," _
                & "'" & V(sheet, i, 35) & "','" & V(sheet, i, 36) & "','" & V(sheet, i, 37) & "'," _
                & "'" & V(sheet, i, 38) & "') "


        con.Execute (Sql)
        
    Next i
    con.Close
    Set con = Nothing

End Function

Function V(sheet, row, col) '处理字符
    Dim value As String
    value = sheet.Cells(row, col)
    value = Replace(value, "'", "")
    value = Replace(value, "\", "")
    V = value
End Function

Function Write2Mysql2(sheet, filterKey)
Dim con As New ADODB.Connection
    Dim Sql As String
    Dim lastRow As Long
       
    
    con.ConnectionString = "Driver={MySQL ODBC 8.0 Unicode Driver};Server=127.0.0.1;DB=kettle;UID=root;PWD=mysqlroot;OPTION=3;"
    con.Open
    'MsgBox ("连接成功！" & vbCrLf & "数据库状态：" & con.State & vbCrLf & "数据库版本：" & con.Version)
    
    lastRow = sheet.Cells(Rows.Count, "A").End(xlUp).row


    For i = 2 To lastRow
        If InStr(V(sheet, i, 27), filterKey) > 0 Then
            Sql = "INSERT INTO dnb_zysj_5 (GDJ, GDDW, TQ, XL, YHBH, YHMC, YDDZ, YHLB, CJZD, ZCBH, JLDBH, SBLB, SBLX, SBMC, CCBH, SJRQ, JDRY, TYRQ, DHPC, TYNX, CCRQ, SBXH, EDDY, EDDL, ZQD, SCCJ, CS, MYLX, JLFS, JLWZ, JLDDZ, TXDZ, BTL, TXMKLX, DBBB_CJ, MYLX_CJ, TXMKLX_CJ) VALUES (" _
                    & "'" & V(sheet, i, 2) & "','" & V(sheet, i, 3) & "','" & V(sheet, i, 4) & "'," _
                    & "'" & V(sheet, i, 5) & "','" & V(sheet, i, 6) & "','" & V(sheet, i, 7) & "'," _
                    & "'" & V(sheet, i, 8) & "','" & V(sheet, i, 9) & "','" & V(sheet, i, 10) & "'," _
                    & "'" & V(sheet, i, 11) & "','" & V(sheet, i, 12) & "','" & V(sheet, i, 13) & "'," _
                    & "'" & V(sheet, i, 14) & "','" & V(sheet, i, 15) & "','" & V(sheet, i, 16) & "'," _
                    & "'" & V(sheet, i, 17) & "','" & V(sheet, i, 18) & "','" & V(sheet, i, 19) & "'," _
                    & "'" & V(sheet, i, 20) & "','" & V(sheet, i, 21) & "','" & V(sheet, i, 22) & "'," _
                    & "'" & V(sheet, i, 23) & "','" & V(sheet, i, 24) & "','" & V(sheet, i, 25) & "'," _
                    & "'" & V(sheet, i, 26) & "','" & V(sheet, i, 27) & "','" & V(sheet, i, 28) & "'," _
                    & "'" & V(sheet, i, 29) & "','" & V(sheet, i, 30) & "','" & V(sheet, i, 31) & "'," _
                    & "'" & V(sheet, i, 32) & "','" & V(sheet, i, 33) & "','" & V(sheet, i, 34) & "'," _
                    & "'" & V(sheet, i, 35) & "','" & V(sheet, i, 36) & "','" & V(sheet, i, 37) & "'," _
                    & "'" & V(sheet, i, 38) & "') "
    
    
            con.Execute (Sql)
        End If
    Next i
    con.Close
    Set con = Nothing
End Function