Генерация файлов Excel с VB6

Question

Я ищу предложения по этому конкретному вопросу:

Какой самый быстрый способ создания файлов Excel (обычный XLS, а не XLSX) в Visual Basic 6 (VB6)?

Большое спасибо.

Answer 1

Excel может читать HTML с Excel 2000.

Самый простой способ - писать таблицы HTML и сохранять их с расширением .xls или, если это веб-приложение, очищать буфер ответов, установить тип ответа "application / vnd.ms-excel" и выписать таблицу больше ни с чем.

Скопируйте и вставьте следующее в Блокнот и сохраните с расширением .xls и откройте его.

<table>
<tr><th>Color</th><th>Shape</th></tr>
<tr><td>Blue</td><td>Square</td></tr>
</table>

Отказ от ответственности:

Я не рекомендую этот метод, потому что он, вероятно, совместим только с Excel, но это самый простой из известных мне способов.

Answer 2

Самый простой способ - установить ссылку в вашем проекте на COM-объект Excel и программно вставить все данные в лист.

Answer 3

Установить ссылку (в меню «Инструменты» в VBA, Project в VB6) на библиотеку объектов Excel (не могу вспомнить точное имя, но она будет начинаться с «Microsoft» и иметь «Excel» где-то в имени ).

Тогда как то так:

Public Sub BuildAndSaveWorkbook

    With New Excel.Workbook
        ' do all the stuff to create the content, then'
        .SaveAs Filename:="WhateverYouWantToCallIt.xls", FileFormat:=xlExcel8
    End With

End Sub

Answer 4

Самый быстрый способ создать файл XLS - использовать драйвер ISAM Jet для Excel. Вот пример того, как это сделать с ADO и ADOX:

' References:
'   Microsoft ActiveX Data Objects 2.8 Library
'   Microsoft ADO Ext. 2.8 for DDL and Security
Option Explicit

Private Sub Command1_Click()
    Dim rs              As ADODB.Recordset

    Set rs = CreateRecordset( _
        "ID", adDouble, _
        "Name", adVarWChar, 200, _
        "Value", adDouble, _
        "Memo", adLongVarWChar)
    rs.AddNew Array("ID", "Name", "Value", "Memo"), _
        Array(1, "test", 5.1, "long long text here")
    rs.AddNew Array("ID", "Name", "Value"), _
        Array(1, "proba", 15.678)
    AppendExcelSheet rs, App.Path & "\test.xls", "My Data", True
    AppendExcelSheet rs, App.Path & "\test.xls", "More Data"
End Sub

Private Function CreateRecordset(ParamArray FldDesc()) As ADODB.Recordset
    Dim lIdx            As Long

    Set CreateRecordset = New ADODB.Recordset
    With CreateRecordset.Fields
        Do While lIdx < UBound(FldDesc)
            Select Case FldDesc(lIdx + 1)
            Case adDouble, adDate, adCurrency, adBoolean
                .Append FldDesc(lIdx), FldDesc(lIdx + 1), , adFldIsNullable
                lIdx = lIdx + 2
            Case adVarWChar
                .Append FldDesc(lIdx), FldDesc(lIdx + 1), FldDesc(lIdx + 2), adFldIsNullable
                lIdx = lIdx + 3
            Case adLongVarWChar
                .Append FldDesc(lIdx), FldDesc(lIdx + 1), -1, adFldIsNullable
                lIdx = lIdx + 2
            Case Else
                Err.Raise vbObjectError, , "Not support Excel data type!"
            End Select
        Loop
    End With
    CreateRecordset.Open
End Function

Private Function AppendExcelSheet( _
            rsSrc As Recordset, _
            sXlsFile As String, _
            Optional ByVal sSheetName As String, _
            Optional ByVal bCreateNew As Boolean) As Boolean
    Dim sConnStr        As String
    Dim oTbl            As ADOX.Table
    Dim oCol            As ADOX.Column
    Dim oFld            As ADODB.Field
    Dim rsDst           As ADODB.Recordset

    '--- init local vars
    sConnStr = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
        "Data Source=" & sXlsFile & ";Extended Properties=""Excel 8.0;Read Only=0"""
    If LenB(sSheetName) = 0 Then
        sSheetName = "Sheet1"
    End If
    '--- cleanup previous file
    If bCreateNew Then
        On Error Resume Next
        SetAttr sXlsFile, vbArchive
        Kill sXlsFile
        On Error GoTo 0
    End If
    '--- create/open workbook and append worksheet
    With New ADOX.Catalog
        .ActiveConnection = sConnStr
        Set oTbl = New ADOX.Table
        oTbl.Name = sSheetName
        For Each oFld In rsSrc.Fields
            Set oCol = New ADOX.Column
            With oCol
                .Name = oFld.Name
                .Type = oFld.Type
            End With
            oTbl.Columns.Append oCol
        Next
        .Tables.Append oTbl
    End With
    '--- copy data to range (named after worksheet)
    If rsSrc.RecordCount > 0 Then
        Set rsDst = New ADODB.Recordset
        rsDst.Open "[" & sSheetName & "]", sConnStr, adOpenDynamic, adLockOptimistic
        rsSrc.MoveFirst
        Do While Not rsSrc.EOF
            rsDst.AddNew
            For Each oFld In rsSrc.Fields
                rsDst.Fields(oFld.Name).Value = oFld.Value
            Next
            rsDst.Update
            rsSrc.MoveNext
        Loop
    End If
End Function

Обратите внимание на расширенное свойство Read Only=0 в строке подключения.