Импорт и экспорт на VB

Function IsExcelLoad() As Boolean
On Error Resume Next
Dim ExcelApp As Object
Set ExcelApp = GetObject(, 'Excel.Application')
If Err.Number <> 0 Then
Err.Clear
IsExcelLoad = False
Else
IsExcelLoad = True
Set ExcelApp = Nothing
End If
End Function
 
Function GetExcelObject() As Object
If IsExcelLoad Then
Set GetExcelObject = GetObject(, 'Excel.Application')
Else
On Error Resume Next
Set GetExcelObject = CreateObject('Excel.Application')
If Err.Number <> 0 Then
Err.Clear
Set GetExcelObject = Nothing
Exit Function
End If
End If
End Function
 
Function NewWorkbook(ExcelApp As Object) As Object
ExcelApp.Workbooks.Add
Set NewWorkbook = ExcelApp.activeWorkbook
End Function
 
Sub main()
Dim ExcelApp As Object, ExcelWB As Object, ExcelWS As Object
Dim i As Long
Dim j As Long
Dim objRst As Recordset
Dim vData As Variant
Dim strFName As String
 
    Set ExcelApp = GetExcelObject()
    ExcelApp.Visible = True
    Set ExcelWB = NewWorkbook(ExcelApp)
    Set objRst = CurrentDb.OpenRecordset('')
    If objRst.RecordCount <> 0 Then
        objRst.MoveLast
        objRst.MoveFirst
        vData = objRst.GetRows(objRst.RecordCount)
        If IsArray(vData) Then
            For i = 0 To UBound(vData, 2)
                For j = 0 To UBound(vData, 1)
                    strFName = ExcelApp.Columns(j + 1).Address
                    strFName = _
                       Right(strFName, Len(strFName) - _
                       (InStr(1, strFName, ':') + 1))
                    ExcelApp.Sheets(1).Range(strFName & i) = _
                       vData(j, i)
                Next j
            Next i
        End If
    End If
End Sub

Sub main()
Dim ExcelApp As Object, ExcelWB As Object
Dim objRst As Recordset
 
    Set ExcelApp = GetExcelObject()
    ExcelApp.Visible = True
    Set ExcelWB = NewWorkbook(ExcelApp)
 
    Set objRst = CurrentDb.OpenRecordset('')
    If objRst.RecordCount <> 0 Then
        ExcelApp.Sheets(1).Range('A1').CopyFromRecordset objRst
    End If
End Sub

  Set objConnect = New ADODB.Connection
  objConnect.ConnectionString = _
    'Driver={Microsoft Excel Driver (*.xls)};' & _
    'DBQ=Путь к файлу;'
  objConnect.Open
  strSQL = 'SELECT * FROM [Лист2$]'
  Set rsSource = New ADODB.Recordset
  rsSource.Open strSQL, objConnect