Обработка данных Excel документа, реально ли обработать такую структуру данных?

Option Explicit
 
Sub EnumWorkboorks()
    Dim fd As FileDialog, vrtSelectedItem As Variant, MyPath As String
    
    Set fd = Application.FileDialog(msoFileDialogFolderPicker)
    
    If fd.Show = -1 Then
        For Each vrtSelectedItem In fd.SelectedItems
            MyPath = vrtSelectedItem
            If Right(MyPath, 1) <> "\" Then MyPath = MyPath & "\"
            Call EnumFolder(MyPath)
        Next vrtSelectedItem
    End If
    
    Set fd = Nothing
End Sub
 
Private Sub EnumFolder(MyPath As String)
    Dim MyName As String, wbk As Workbook
    
    MyName = Dir(MyPath & "*.xls", vbNormal)
    Do While MyName <> ""
        If (GetAttr(MyPath & MyName) And vbNormal) = vbNormal Then
        If MyName Like "*.xls" Then
            Set wbk = Workbooks.Open(MyPath & MyName)
            
            Call EnumWorksheets(wbk)
            wbk.Close False
            
            Set wbk = Nothing
        End If
        End If
    MyName = Dir
    Loop
End Sub
 
Private Sub EnumWorksheets(wbk As Workbook)
    Dim wsh As Worksheet
    
    For Each wsh In wbk.Worksheets
        Call ExportData(wsh)
    Next
End Sub
 
Private Sub ExportData(wsh As Worksheet)
    Dim i As Long, m As Long
    
    For m = wsh.UsedRange.Column + wsh.UsedRange.Columns.Count - 1 To 1 Step -1
        If wsh.Columns(m).Text = "" Then Else Exit For
    Next
    
    For i = 2 To m Step 2
        InsertRecord _
            wsh.Parent.Name, _
            wsh.Name, _
            wsh.Cells(1, i).Value, _
            wsh.Cells(3, i).MergeArea.Cells(1).Value, _
            wsh.Cells(4, i).MergeArea.Cells(1).Value, _
            wsh.Cells(5, i).MergeArea.Cells(1).Value, _
            wsh.Cells(5, 1).Value
    Next
End Sub
 
Private Sub InsertRecord(F1 As String, F2 As String, F3 As Long, F4 As String, F5 As Long, F6 As Date, F7 As Long)
    Dim cn As ADODB.Connection, rs As ADODB.Recordset
    
    Set cn = New ADODB.Connection
    cn.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & _
        ThisWorkbook.Path & "\base.mdb;User Id=admin;Password=;"
    cn.Open
    
    Set rs = New ADODB.Recordset
    rs.Open "INSERT INTO MyTab VALUES (""" & F1 & """, """ & F2 & """, " & F3 & ", """ & F4 & """, " & F5 & ", """ & Format(F6, "dd.mm.yyyy") & """, " & F7 & ")", cn, adOpenKeyset, adLockOptimistic
    
    Debug.Print F1, F2, F3, F4, F5, F6, F7
    
    cn.Close
    Set cn = Nothing
End Sub