Импорт большого вида на рабочий лист Excel

Question

У меня есть большой вид, созданный в vfp. Взгляд достиг около 4 миллионов записей. Мне нужно подключиться к нему и импортировать его в книгу Excel.

При импорте произошла ошибка, когда рабочий лист достиг предела (1,5 миллиона записей).

Любые решения? Я собираюсь импортировать его в шланги на разные рабочие листы, но пока не нашел решений.

Answer 1

Это ограничение MS Excel. Вы не можете этого избежать. Или экспортировать в другой формат, установленный в листе Excel.

Answer 2

4 миллиона записей действительно слишком много для превосходства. Но если вам нужно подключиться к папке dbf через vba и вручную накачать данные в excel.

Но это будет очень медленно.

Вот код, который вы можете использовать. Импортирует 1,5 миллионные линии в каждый рабочий лист, и это, вероятно, слишком много. Я бы использовал 100 000 строк или около того. но это твой звонок

Я не могу его запустить, но должен быть прав.

Option Explicit 
Sub import() 

    Dim con As Object 
    Dim rst As Object 
    Dim sql As String 
    Dim DbFolderPath As String 
    Dim i As Long 
    Dim ii As Integer 

    DbFolderPath = ThisWorkbook.Path & "\" 
    Application.ScreenUpdating = False 
    Set con = CreateObject("ADODB.connection") 
    con.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & DbFolderPath & ";Extended Properties=dBASE IV;" 
    sql = "SELECT * FROM myquery" 

    Set rst = CreateObject("ADODB.recordset") 
    rst.CursorLocation = 3 'adUseClient 
    rst.CursorType = 1 'adOpenKeyset 

    rst.Open sql, con 

    ReDim myValues(rst.RecordCount, 4) 
    ThisWorkbook.Sheets(0).Activate 
    i = 1 
    ii = 0 
    If Not (rst.EOF And rst.BOF) Then 
     rst.MoveFirst 
     Do Until rst.EOF = True 
      Cells(i, 1) = rst!Field1 
      Cells(i, 2) = rst!Field2 
      rst.MoveNext 
      i = i + 1 
      If i > 1500000 Then 
      i = 1 
      ii = ii + 1 
      ThisWorkbook.Worksheets.Add 
      ThisWorkbook.Sheets(ii).Activate 
      End If 

     Loop 
    Else 
     GoTo cleanup 
    End If 
    Columns("A:B").EntireColumn.AutoFit 
    GoTo cleanup 
    Exit Sub 
cleanup: 
    On Error Resume Next 
    rst.Close 
    con.Close 
    Set rst = Nothing 
    Set con = Nothing 
    Application.ScreenUpdating = True 
Exit Sub 
End Sub