Dim DB As DAO.Database
    Dim TB As DAO.TableDef
    Set DB = DBEngine.Workspaces( 0 ).CreateDatabase(ПУТЬ & "tmp", dbLangCyrillic)
    
    'присоединю базы dbf к tmp.mdb
    Set TB = DB.CreateTableDef(имя_базы_без_DBF)
    TB.Connect = "dBase IV;DataBase=" & ПУТЬ
    TB.SourceTableName = имя_базы_без_DBF   ' или другое, например Таблица1
    DB.TableDefs.Append TB
    Set TB = Nothing
    
    DB.Close:   Set DB = Nothing

Dim WIN:	WIN = "АБВГДЕЖЗИЙКЛМНОПРСТУФХЦЧШЩЪЫЬЭЮЯабвгдежзийклмнопрстуфхцчшщъыьэюяжм√№"
Dim DOS:	DOS = "└┴┬├─┼╞╟╚╔╩╦╠═╬╧╨╤╥╙╘╒╓╫╪┘┌█▄▌▐▀рстуфхцчшщъыьэюяЁёЄєЇїЎў°∙·√№¤■ │╖v╣"

'   вывод в excel через ADO для VBScript
    Dim path_dbf:     path_dbf = "C:\ПУТЬ К DBF"
    Dim basa_dbf:     basa_dbf = "basa.dbf"

    Dim cnn:        Set cnn = WScript.CreateObject("ADODB.Connection")
    Dim rst:        Set rst = WScript.CreateObject("ADODB.Recordset")
    
    cnn.ConnectionString = "DRIVER={Microsoft dBase Driver (*.dbf)};" & "DBQ=" & path_dbf & ";" & "DefaultDir=" & path_dbf & "\"
    cnn.Open
    rst.Open "SELECT * FROM " & basa_dbf, cnn
    
    Dim XLS
    Set XLS = WScript.CreateObject("Excel.Application")
    
    XLS.WorkBooks.Add

    'Создание заголовков
    Dim i
    For i =  0  To rst.Fields.Count -  1 
        XLS.Cells( 1 , i +  1 ).Value = rst.Fields(i).Name
    Next

    'Вставка рекордсета
    XLS.Range("A2").CopyFromRecordset rst ' со следующей строки
    
    rst.Close
    cnn.Close

    XLS.Visible = True
    
    Set XLS = Nothing
    Set rst = Nothing
    Set cnn = Nothing

Private Sub Command1_Click()
    On Error GoTo m1

    Dim DB As DAO.Database
    Dim RS As DAO.Recordset
    Dim TB As DAO.TableDef
    Set DB = DBEngine.Workspaces( 0 ).CreateDatabase(App.Path & "\tmp", dbLangCyrillic)
    
    Dim basa As String:     basa = "ИМЯ БАЗЫ DBF БЕЗ РАСШИРЕНИЯ"
    
    'присоединю базы dbf к tmp.mdb
    Set TB = DB.CreateTableDef(basa)
    TB.Connect = "dBase IV;DataBase=" & App.Path
    TB.SourceTableName = basa
    DB.TableDefs.Append TB
    Set TB = Nothing
    DB.Close:   Set DB = Nothing
    
    Set DB = OpenDatabase(App.Path & "\tmp", True)
    Set RS = DB.OpenRecordset("Select * From " & basa)

    Dim xl
    Set xl = CreateObject("Excel.Application")
    xl.Visible = False
    xl.Workbooks.Add
    xl.Sheets("Лист1").Name = basa
    xl.Application.ScreenUpdating = False
    Dim i As Integer

    'Создание заголовков
    For i =  0  To RS.Fields.Count -  1 
        xl.Cells( 1 , i +  1 ).Value = RS.Fields(i).Name
    Next i
    'Вставка рекордсета в новый лист
    xl.ActiveSheet.Range("A2").CopyFromRecordset RS ' со следующей строки
    
    xl.Visible = True
    xl.Application.ScreenUpdating = True
    Set xl = Nothing

    RS.Close:   Set RS = Nothing
    DB.Close:   Set DB = Nothing
    Exit Sub
m1:
    MsgBox Err.Description
    Set RS = Nothing
    Set TB = Nothing
    Set DB = Nothing
End Sub