I have a large view created in vfp. The view reached around 4 million record. I need to connect to it in and import it in an excel workbook.
While importing an error occurred that the worksheet reached it limits around (1.5 million record).
Any solutions? I am thinking of importing it in shunks to different worksheets but found no solutions yet.
This is MS Excel restriction. You cannot avoid this. Or export to another format insted of Excel sheet.
4 million records is really too much for excel. But if you have to you should connect to the dbf folder through vba and pump the data manually into excel.
But that is going to be really slow.
Here is code you can use.
It imports 1.5 mill lines into each worksheet and that is problably too much. I would use 100.000 lines or so. but thats your call
I havent run it but should be about right.
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
Related
I've been fighting for a long time with import formula record in database (=45+5 or =SUM(D20:D23)) to Excel worksheet. My problem is when I import formula from database in Excel cell is raw text from database record (=45+5 or =SUM(D20:D23)).
It's fine, but I'm not able to calculate this formula. I've tried options in VBA after importing from database like:
ActiveSheet.Calculate, Worksheets(1).Calculate, ActiveWorkbook.Calculate
Only manual one manual option works. When I set to cell with formula and hit ENTER.
But I want to automate this process.
----EDIT----
Original code:
Sub GetDataFieldInfo()
Dim conn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim address_complete As String
Dim address_column As Integer
Dim address_row As Integer
Dim j As Integer
db_file = ThisWorkbook.Path & "\Example_db.mdb"
Set conn = New ADODB.Connection
conn.ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
";Data Source=" & db_file & _
";Persist Security Info=False"
conn.Open
Set rs = conn.Execute("SELECT * FROM Students")
For i = 0 To rs.Fields.Count - 1
address_complete = findCellAddress(rs(i).Name)
address_row = Range(address_complete).Row
address_column= Range(address_complete).Column
rs.MoveFirst
j = 0
Do Until rs.EOF
If InStr(1, rs.Fields(rs(i).Name), "=", 1) Then
Cells(address_row + 1 + j, address_column).Formula = rs.Fields(rs(i).Name).Value
Else
Cells(address_row + 1 + j, address_column).Value = rs.Fields(rs(i).Name)
End If
j = j + 1
rs.MoveNext
Loop
Next
rs.Close
End Sub
You are probably doing Range("A1") = "=SUM(D20:D23)".
Instead of this you should do Range("A1").value = "=SUM(D20:D23)".
If this is not the case, please show us the VBA code you are using to export from msaccess to excel. It will help a lot.
Hi Im making a Excel Form in which my Database is an access.
First I Encode data in Excel then Using Command Button to Post these data.
The code within the Command Button.. first get the Max Number from Access and use that Number to Complete the Data in Excel to be exported to Access. The Problem is If I use 2 and above users to simultaneously Post it will consolidate all the data into one with the same Number.
What I want is to lock opening data until posted since i need to get the max number of a column then add 1 first then import a complete set of data including the MAX number as a control number.
I tried using Do While adStateOpen <> 1 and also Do While IsRecordBusy = True then wait and loop and set the recordset to nothing instead of closing it twice. But it wont work it will consolidate the data with the same control number.
Below is my Code
Option Explicit
Sub ImportJEData()
Dim cnn As ADODB.Connection 'dim the ADO collection class
Dim rst As ADODB.Recordset 'dim the ADO recordset class
Dim dbPath
Dim x As Long, i As Long
Dim nextrow As Long
Dim Var
Dim LockType
Dim SQL
Dim IsRecordBusy
'add error handling
On Error GoTo errHandler:
'Variables for file path and last row of data
dbPath = Sheets("Update Version").Range("b1").Value
Set Var = Sheets("JE FORM").Range("F14")
nextrow = Sheets("LEDGERTEMPFORM").Cells(Rows.Count - 5, 1).End(xlUp).Row
'Initialise the collection class variable
Set cnn = New ADODB.Connection
'Create the ADODB recordset object. for Max Number
Set rst = New ADODB.Recordset 'assign memory to the recordset
LockType = adLockPessimistic
'Do While adStateOpen <> 1
Do While IsRecordBusy = True
Application.Wait (Now + TimeValue("0:00:01") / 1000)
Loop
SQL = "SELECT distinct Max(DVNumber),Max(ChckID) FROM DV "
rst.Open SQL, cnn
Sheets("Max").Range("A2").CopyFromRecordset rst
Set rst = Nothing
Set rst = New ADODB.Recordset 'assign memory to the recordset
rst.Open Source:="DV", ActiveConnection:=cnn, _
CursorType:=adOpenDynamic, LockType:=adLockPessimistic, _
Options:=adCmdTable
On Error Resume Next
'you now have the recordset object
'add the values to it
For x = 7 To nextrow
rst.AddNew
For i = 1 To 37
rst(Sheets("LEDGERTEMPFORM").Cells(6, i).Value) = Sheets("LEDGERTEMPFORM").Cells(x, i).Value
Next i
rst.Update
Next x
'close the recordset
rst.Close
' Close the connection
cnn.Close
'clear memory
Set rst = Nothing
Set cnn = Nothing
'Update the sheet
Application.ScreenUpdating = True
'Clear the data
On Error GoTo 0
Exit Sub
errHandler:
'clear memory
Set rst = Nothing
Set cnn = Nothing
MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure Export_Data"
End Sub
Im finally done with this code. I just added another Table in access where such table is unique the uses sql to get the max+1 and insert it back and loop it if error occurs because of the duplicate. Heres the code below
Do
On Error Resume Next 'reset Err.obj.
'Get the Max ID +1
Set rst = Nothing
Set rst = New ADODB.Recordset 'assign memory to the recordset
SQL = "SELECT Max(ApNumber)+1 FROM PayVoucherID "
rst.Open SQL, cnn
'Check if the recordset is empty.
'Copy Recordset to the Temporary Cell
Sheets("MAX").Range("A2").CopyFromRecordset rst
'Insert the Data to Database And Check If no Errors
Sql2 = "INSERT INTO PayVoucherID(ApNumber)Values('" & Sheets("MAX").Range("A2") & "') "
cnn.Execute Sql2
Loop Until (Err.Number = 0)
Hope this helps for Excel Front users.
I have been doing some database work with excel both as the database and the database driver via macros with vba. I built a function that should parse through a list of database records with testID fields. I wanted to display each test only once based on it's testID, but the way the database is set up means I have to eliminate duplicate testID's. I do this by iterating through the recordset and checking the current test against the previous one before showing in the list. The problem I'm having is that the function is excruciatingly slow. For only 12 tests in the database, it takes about 3 seconds to display them in the view spreadsheet. I'd love to hear some ideas on how to optimize the run-time. Here's the function:
Public Function showAllTests()
Dim conn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim cstring, sql As String
Dim r, c As Integer
Dim testsAr As Variant
Dim inAr As Boolean
cstring = "Provider = Microsoft.ACE.OLEDB.12.0; Data Source=I:\DBtrials.xlsx; Extended Properties=""Excel 12.0 Xml; HDR=YES;ReadOnly=False"";"
sql = "SELECT [TestID], [Status], [PFIBox], [WireType], [StartingDia], [Customer], [numSamples], [Assigned] FROM [Tests$]"
Set conn = New ADODB.Connection
Set rs = New ADODB.Recordset
Call conn.Open(cstring)
Set rs = conn.Execute(sql)
If rs.EOF Then
Range("C6:J1000").ClearContents
End If
r = 6
count = 0
'Iterates through the recordset, eliminating duplicates and populating cells in the tests sheet
While Not rs.BOF And Not rs.EOF
Dim prevID, currID As String
Dim currCell As Range
inAr = False
If Not count = 0 Then
prevID = ActiveWorkbook.Sheets("Tests").Cells(r - 1, 3).Value
currID = CStr(rs(0))
If prevID = currID Then
inAr = True
End If
End If
For c = 3 To (rs.Fields.count + 2)
Set currCell = ActiveWorkbook.Sheets("Tests").Cells(r, c)
If Not IsNull(rs(c - 3).Value) And inAr = False Then
currCell.Value = CStr(rs(c - 3))
ElseIf IsNull(rs(c - 3).Value) Then currCell.Value = ""
Else:
Exit For
End If
Next c
If inAr = False Then
r = r + 1
End If
rs.MoveNext
count = count + 1
Wend
conn.Close
Set conn = Nothing
End Function
use GROUP BY
sql = "SELECT [TestID], [Status], [PFIBox], [WireType], [StartingDia], [Customer], [numSamples], [Assigned] FROM [Tests$] GROUP BY [TestID]"
Also some of these drivers - Microsoft.ACE.OLEDB.12.0 etc have terrible perfomance in VBA. sometimes i get better perforamance from OBDC 6.2 than ADO
I've spent the last few hours scouring the net for a way to do this without finding a way.
Basically, I have 3 fairly small tables in access that I wish to transfer to an excel workbook on a single worksheet.
I am currently only able to insert these tables onto separate worksheets using the following coding:
DoCmd.TransferSpreadsheet transfertype:=acExport, _
spreadsheettype:=acSpreadsheetTypeExcel12, _
TableName:=DTable, FileName:=strWorksheetPathTable, _
hasfieldnames:=True, _
Range:="Data"
I wish to transfer 2 more tables onto the "Data" worksheet, 1 starting at D1 (table is a single column) and the other at G1.
If anyone could help me out with a push that'd be sweet.
Cheers, Dane I
add microsoft.activex data objects 2.8 to your references
add microsoft office object library to your references
Then create your spreadsheet like this:
dim xl as object: set xl = createobject("Excel.Application")
XL.Visible = False
XL.DisplayAlerts = False
dim wb as object: set wb = xl.Workbooks.Add
dim ws as object: set ws = wb.Worksheets(1)
dim rst as new adodb.recordset
dim r as long, c as long 'row and column
r = 1
c = 1
rst.open "SELECT * FROM Table1", currentproject.connection, adOpenKeyset, adLockReadOnly
if not rst.eof then
ws.range(WS.Cells(r, c).Address).CopyFromRecordSet rst
end if
rst.close
rst.open "SELECT Count(*) FROM Table1", currentproject.connection etc
r = r + rst.fields(1) + 2
rst.Close
rst.open "SELECT * FROM Table2", etc
and so on.
wb.SaveAs FileName:=xlname
xl.Quit
set ws = nothing
set wb = nothing
set xl = nothing
This gives you what you want, with a line or two between each table. You can also now add code into the process to format your spreadsheet how you want if you wish to as well.
If a table needs column headings get them like this:
rst.open "SELECT * FROM Table1", currentproject.connection, adOpenKeyset, adLockReadOnly
dim ii as long
for ii = 0 to rst.fields.count - 1
ws.cells(r, ii + 1) = rst.fields(ii) 'you can offset using c if you want
next
if not rst.eof then
ws.range(WS.Cells(r, c).Address).CopyFromRecordSet rst
end if
I'm trying to take an ADO Recordset and then loop through it to parse individual rows to different worksheets within an Excel workbook. Unfortunately, as I step through my code, I get the following error: Run-time error '13': Type mismatch. This occurs when I call the sub in my code - it never actually steps into the sub. I'm wondering if I'm somehow not passing the Recordset in correctly or if it's a problem somewhere within my loop.
Regardless, here's my code - any help is greatly appreciated!
Sub SplitData(ByVal rs As ADODB.Recordset)
' Instantiate count variables for each result type
' Start at 2 to give room for Table headers on sheets
Dim NewAppsCount, BadLogCount, MatNotesCount, ZeroBalCount As Integer
NewAppsCount , BadLogCount, MatNotesCount, ZeroBalCount = 2
' Row Counter
Dim Count As Long
Count = 0
' Loop through the recordset and parse rows to appropriate worksheets
Do While Not rs.EOF
If CStr(rs.Fields("Maturity Date")) = "" Then
If CStr(rs.Fields("Log_Date")) = "" Then
' Applications that have not been properly logged
Sheet4.Range("A" & CStr(BadLogCount)) = rs.Fields(Count).Value
Count = Count + 1
BadLogCount = BadLogCount + 1
Else
' New Applications
Sheet6.Range("A" & CStr(NewAppsCount)) = rs.Fields(Count).Value
Count = Count + 1
NewAppsCount = NewAppsCount + 1
End If
Else
If Month(rs.Fields("Maturity Date")) < Month(Date) Then
' Maturing Notes with Zero Outstanding Balance
Sheet7.Range("A" & CStr(ZeroBalCount)) = rs.Fields(Count).Value
Count = Count + 1
ZeroBalCount = ZeroBalCount + 1
Else
' Maturing Notes
Sheet8.Range("A" & CStr(MatNotesCount)) = rs.Fields(Count).Value
Count = Count + 1
MatNotesCount = MatNotesCount + 1
End If
End If
rs.MoveNext
Loop
End Sub
Here is the sub that call GetData:
Sub GetData(ByVal Update As Boolean)
Dim conn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim query As String
Dim path As String
Dim prompt, result As Integer
Dim day, today As String
' ...skipping stuff not related to the issue...
' Set the UNC Path
path = "\\this\is\the\path"
' Instantiate ADO Objects
Set conn = New ADODB.Connection
Set rs = New ADODB.Recordset
' Connect to data source
conn.Open "Provider=Microsost.JET.OLEDB.4.0;Data Source=" & path & ";"
' The Query
query = "This is a big 'ol query that I won't repost here"
'Run the query and populate the Recordset object
rs.CursorLocation = adUseClient
rs.Open query, conn, adOpenStatic, adLockReadOnly
'Parse contetns of Recordset to worksheet
Application.ScreenUpdating = False
Me.SplitData(rs)
'Close the ADO Objects, set them to null, and exit sub
rs.Close
conn.Close
Set rs = Nothing
Set conn = Nothing
Exit Sub
End Sub
Try changing:
Me.SplitData(rs)
to:
Me.SplitData rs
Unnecessary parentheses often cause problems in VBA.
(NB I'm assuming that the two Sub shown are in a context where Me makes sense - e.g. class module, ThisWorkbook module, worksheet module, backing a UserForm etc)