Как передать массив данных в VBA?

Требуется получить большой массив данных из приложения в VBA (Excel). Как это можно сделать, не используя временный файл?

Открыть Excel как OLE объект и читать данные непросредственно с листа. Если надо, брошу пример.

С уважением, Михаил.

0

Огромное спасибо, и примерчик хорошо бы посмотреть, правда мне нужно передать данные в EXCEL из приложения.

Скорость передачи данных в OLE медленная, если данных много, то, как показывает практика, гораздо быстрее передача через Clipboard (разделяя столбцы табуляцией, а строки - переходом на новую строку, естественно в самих данных не должно быть табуляций и переводов строки), например

0

1. В проект включаешь библиотеку excel8.olb
2. Содаешь модуль со следующими содержанием:
Public Function xlOPEN_EXCEL_APP(ByRef FLAG As Long) As Object

On Error GoTo ERR_OPEN_EXCEL_APP

If EXCEL_RUNNING Then
Set xlOPEN_EXCEL_APP = GetObject(, 'EXCEL.APPLICATION')
Else
Set xlOPEN_EXCEL_APP = CreateObject('EXCEL.APPLICATION')
End If
FLAG = 0

Exit Function

ERR_OPEN_EXCEL_APP:
MsgBox 'Произошла ошибка - ' & Err.NUMBER & vbCr & _
Err.Description, _
vbOKOnly + vbCritical, _
'Ошибка OLE'
Set xlOPEN_EXCEL_APP = Nothing
FLAG = Err.NUMBER
Err.Clear

End Function

Public Function EXCEL_RUNNING() As Boolean

Dim hWnd As Long

On Error Resume Next
' Если Excel выполняется, этот вызов API возвращает его дескриптор.
hWnd = FindWindow('XLMAIN', 0)
'If hWnd = 0 Then ' 0 означает, что Excel не выполняется.
EXCEL_RUNNING = (hWnd <> 0)
ExcelWasNotRunning = (hWnd = 0)
Err.Clear ' Очищаем объект Err на случай ошибки.

End Function

Public Function xlOPEN_BOOK(Excel As Object, xlPATH As String, _
Optional ByRef RESULT As Long) As Workbook

On Error GoTo ERR_OPEN_BOOK

Set xlOPEN_BOOK = Excel.Workbooks.Open(xlPATH)
RESULT = 0

Exit Function

ERR_OPEN_BOOK:
Set xlOPEN_BOOK = Nothing
RESULT = Err.NUMBER
Err.Clear

End Function

Public Function xlWB_OPENED(Excel As Object, WB_INDEX As Variant, _
Optional ByRef FLAG As Long) As Boolean

Dim WB_CNT As Integer

On Error GoTo ERR_WB_OPENED

WB_CNT = Excel.Workbooks.Count
If WB_CNT = 0 Then
FLAG = 0
xlWB_OPENED = False
Exit Function
End If

If IsNumeric(WB_INDEX) Then
FLAG = 0
xlWB_OPENED = (WB_INDEX <= WB_CNT)
Exit Function
End If

For WB_CNT = 1 To Excel.Workbooks.Count
If Excel.Workbooks(WB_CNT).NAME = WB_INDEX Then
FLAG = 0: xlWB_OPENED = True
Exit Function
Exit For
End If
Next WB_CNT

FLAG = 0: xlWB_OPENED = False
Exit Function

ERR_WB_OPENED:
FLAG = Err.NUMBER: Err.Clear
xlWB_OPENED = False

End Function

Public Function PVT_xlFSPLIT(FULL_PATH_NAME As String, _
ByRef sDRIVE As String, ByRef sDIR As String, _
ByRef SNAME As String, ByRef sEXT As String) As Integer

Dim posCHAR%, I As Integer, sREMAINS$, sMIRROR As String

On Error GoTo ERR_FSPLIT

If FULL_PATH_NAME = '' Then
PVT_xlFSPLIT = -1
Exit Function
End If

posCHAR = InStr(1, FULL_PATH_NAME, ':', vbTextCompare)

Select Case posCHAR
Case 0
sDRIVE = ''
sREMAINS = FULL_PATH_NAME
Case 2
sDRIVE = Mid$(FULL_PATH_NAME, 1, 1)
If Mid$(FULL_PATH_NAME, 3, 1) = ' ' Then
sREMAINS = Mid$(FULL_PATH_NAME, 4, Len(FULL_PATH_NAME) - 3)
Else
sREMAINS = Mid$(FULL_PATH_NAME, 3, Len(FULL_PATH_NAME) - 2)
End If
Case Else
PVT_xlFSPLIT = -1
Exit Function
End Select

I = Len(sREMAINS)
If I = 0 Then
PVT_xlFSPLIT = -1
Exit Function
End If

If Mid$(sREMAINS, 1, 1) = '.' Then
PVT_xlFSPLIT = -1
Exit Function
End If

sMIRROR = PVT_xlTAIL_TO_HEAD(sREMAINS)
posCHAR = InStr(1, sMIRROR, '.', vbTextCompare)
If posCHAR <> 0 Then
s

0