Ускорение экспорта в Excel

[tron]

Кому импортить проект неохота вот основные части простым текстом:
Таким образом формируется файл из Axapta 3.0

PHP код:

// Tron 01.10.2004
void finalize()
{
    TextBuffer      textBuffer = new TextBuffer();
    ;
    // Добавляем тип файла
    csvTextBuffer = "1;" + csvTextBuffer;

    textBuffer.setText(csvTextBuffer);
    textBuffer.toFile("c:\\data.csv");

    this.dks_runMacro("Main");
    super();
} 


А вот собственно макрос на Visual Basic:

PHP код:

Rem Tron 01.10.2004
Rem Загрузка данных из внешних файлов // Axapta
Rem Ver. 1.0.1.5

Dim CurrentString As String
Dim Variables As String
Dim I As Long
Dim NowChar As Long

Dim FromRange As String
Dim ToRange As String
Dim Value As String

Sub Main()
    Application.ScreenUpdating = False
    Application.Visible = False
        
    Import
 
    Sheets(1).Name = "Отчет"
    Worksheets(1).Activate
    Application.Visible = True
    Application.ScreenUpdating = True
End Sub

Sub Import()
On Error GoTo ErrorHandler
        Open "c:\data.csv" For Input Access Read As #1
        Line Input #1, Variables
    
        Do While Not EOF(1)
            Line Input #1, CurrentString
            FillWorkSheet
        Loop
    
        Close #1
Exit Sub
ErrorHandler:
    Worksheets(1).Range("A1").Value = "Произошла ошибка обмена данными"
Exit Sub
    
End Sub

Sub FillWorkSheet()
    NowChar = 3
    Worksheets(1).Activate
    
    Rem Dks_copyBookMark
    If (Left(CurrentString, 1) = "1") Then
        FromRange = ReturnPart
        ToRange = ReturnPart
        Range(FromRange).Select
        Selection.Copy
        Range(ToRange).Select
        Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
            SkipBlanks:=False, Transpose:=False
        ActiveSheet.Paste
    Rem InsertValue
    ElseIf (Left(CurrentString, 1) = "2") Then
        ToRange = ReturnPart
        Value = ReturnPart
        Worksheets(1).Range(ToRange).Value = Value
    Rem DeleteRow
    ElseIf (Left(CurrentString, 1) = "3") Then
        ToRange = ReturnPart
        CurrentRegion = ToRange + ":" + ToRange
        Rows(CurrentRegion).Select
        Selection.Delete Shift:=xlUp
    Rem DeleteColumn
    ElseIf (Left(CurrentString, 1) = "4") Then
        ToRange = ReturnPart
        CurrentRegion = ToRange + ":" + ToRange
        Columns(CurrentRegion).Select
        Selection.Delete Shift:=xlToLeft
    End If
    
    
End Sub

Function ReturnPart() As String
    ReturnPart = ""
    For NowChar = NowChar To Len(CurrentString)
        If (Mid(CurrentString, NowChar, 1) = ";") Then
            Exit For
        End If
        ReturnPart = ReturnPart + Mid(CurrentString, NowChar, 1)
    Next
    NowChar = NowChar + 1
End Function