vba-选择文件根据设置导入数据库

'选择文件导入
Private Sub SelectFile_Click()
        Dim sheet As Excel.Worksheet
        Dim fieldNameArr(), columnNumArr()
        Dim sql As String
        '变量赋值
        fieldNameArr = Array("HUB客户编号")
        columnNumArr = Array(2)
        sql = "select top 1 * from 交易信息表"
        '打开选择文件
        Set sheet = HandlerFunction.GetSheetByOpenFile()
        If sheet Is Nothing Then
        Else
            HandlerFunction.InsertToDbBySheet sheet, fieldNameArr, columnNumArr, sql
        End If
End Sub

'打开文件并返回Sheet
Public Function GetSheetByOpenFile() As Worksheet
    ifilename = Application.GetOpenFilename("Excel(*.xlsx), *.xlsx, Excel(*.xls), *.xls", False)
    
    If ifilename <> "False" Then
        Dim xlApp As Excel.Application
        Dim xlBook As Excel.Workbook
        Set xlApp = New Excel.Application
        
        Set xlBook = xlApp.Workbooks.Open(ifilename)
        Dim sheet As Excel.Worksheet
    
        Set sheet = xlBook.Sheets(1)
        Set GetSheetByOpenFile = sheet
    Else
        MsgBox "Please select a file first!", vbOKOnly, "Reminder"
        Exit Function
    End If
    
On Error Resume Next
    Set xlBook = Nothing
    Set xlApp = Nothing
End Function

'根据sheet数据新增到数据库 filedNameArr插入的字段名数组，columnNumArr数据源Excel中对于的列，必须一一对应
Public Sub InsertToDbBySheet(ByVal sheet As Excel.Worksheet, filedNameArr(), columnNumArr(), ByVal sql As String)
On Error GoTo Get_Err
    Dim arr
    '导入数据源
    arr = sheet.Range("A2").CurrentRegion
    
    Dim rst As ADODB.Recordset
    Dim cnn As New ADODB.Connection
    Set rst = New ADODB.Recordset
    cnn.Open AccessConnection
    rst.Open sql, cnn, adOpenKeyset, adLockOptimistic
    cnn.BeginTrans
        
    For i = 2 To UBound(arr) '行数量
        rst.AddNew
        For j = 0 To UBound(filedNameArr)
            rst.Fields(filedNameArr(j)) = arr(i, columnNumArr(j))
        Next j
        rst.Update
    Next i
        
    cnn.CommitTrans '提交事务
                    
    MsgBox "导入成功！", vbOKOnly, "ReMinder"
    ' clean up
    rst.Close
    cnn.Close
    Set rst = Nothing
    Set cnn = Nothing
    Exit Sub
Get_Err:
    ' clean up
    If Not rst Is Nothing Then
        If rst.State = adStateOpen Then rst.Close
    End If
    Set rst = Nothing
 
    If Not cnn Is Nothing Then
        If cnn.State = adStateOpen Then cnn.Close
    End If
    Set cnn = Nothing
End Sub