So I navigated to the following MSDN Resource Page that addresses how to use ADO objects. My problem is that I cannot get it to work.
What I am trying to do is open a CSV file and read it line-by-line, then create SQL INSERT statements to insert the records into an existing Table in Access 2010. I have tried to find an easier method of doing this, but this appears to be my only option. doing this with the included tools, but so far, I haven't had any luck.
The main issue here is that I have CSV files with inconsistent headings. I want to import 5 files into the same table, but each file will be different depending on which fields contained data. Those fields with no data in them were ignored during the extract. This is why I can't use something like DoCmd.TransferText.
So, now I need to create a script that will open the text file, read the headers in the first line and create a SQL INSERT statement dependent on the configuration of that particular file.
I have a feeling that I have a good handle on how to appraoch the issue, but no matter what I try, I can't seem to get things working using ADO.
Could anyone explain how I can achieve this? My sticking point is getting the Access DB to receive information from the CSV files via ADO.
Instead of reading the CSV file line-by-line, then doing something with each line, I think you should open the file as an ADO recordset. And open a DAO recordset for your Access destination table.
You can then iterate through the fields in each row of the ADO recordset and add their values into a new row of the DAO recordset. As long as the destination table includes fields with the same names and compatible data types as the CSV fields, this can be fairly smooth.
Public Sub Addikt()
#If ProjectStatus = "DEV" Then
' needs reference for Microsoft ActiveX Data Objects
Dim cn As ADODB.Connection
Dim fld As ADODB.Field
Dim rs As ADODB.Recordset
Set cn = New ADODB.Connection
Set rs = New ADODB.Recordset
#Else ' assume PROD
Const adCmdText As Long = 1
Const adLockReadOnly As Long = 1
Const adOpenForwardOnly As Long = 0
Dim cn As Object
Dim fld As Object
Dim rs As Object
Set cn = CreateObject("ADODB.Connection")
Set rs = CreateObject("ADODB.Recordset")
#End If
Const cstrDestination As String = "tblMaster"
Const cstrFile As String = "temp.csv"
Const cstrFolder As String = "C:\share\Access"
Dim db As DAO.Database
Dim rsDao As DAO.Recordset
Dim strConnectionString As String
Dim strName As String
Dim strSelect As String
strConnectionString = "Provider=" & _
CurrentProject.Connection.Provider & _
";Data Source=" & cstrFolder & Chr(92) & _
";Extended Properties='text;HDR=YES;FMT=Delimited'"
'Debug.Print strConnectionString
cn.Open strConnectionString
strSelect = "SELECT * FROM " & cstrFile
rs.Open strSelect, cn, adOpenForwardOnly, _
adLockReadOnly, adCmdText
Set db = CurrentDb
Set rsDao = db.OpenRecordset(cstrDestination, _
dbOpenTable, dbAppendOnly + dbFailOnError)
Do While Not rs.EOF
rsDao.AddNew
For Each fld In rs.Fields
strName = fld.Name
rsDao.Fields(strName) = rs.Fields(strName).value
Next fld
rsDao.Update
rs.MoveNext
Loop
rsDao.Close
Set rsDao = Nothing
Set db = Nothing
rs.Close
Set rs = Nothing
cn.Close
Set cn = Nothing
End Sub
This is the Declarations section of the module where I saved that procedure:
Option Compare Database
Option Explicit
#Const ProjectStatus = "DEV" '"DEV" or "PROD"
Change the values for these constants to test it on your system:
Const cstrDestination As String = "tblMaster"
Const cstrFile As String = "temp.csv"
Const cstrFolder As String = "C:\share\Access"
Note the folder name does not include a trailing backslash.
You will want to adapt that procedure to pass the file name as a parameter instead of leaving it as a constant. And, if your CSV files are stored in more than one directory, you will want to pass the folder name as a parameter, too.
Hopefully showing you how to do it for one file will be enough and you can then take it from here to handle all your CSV files. Also consider adding error handling.
I think the previous answer is unnecessarily complicated. All you need to do it send an XMLHTTP request. That fetches the CSV data as a string, which can then be parsed into a table.
I've posted a VBA subroutine that does that in an answer to a similar question. Documentation of where I found the techniques is in the code comments. I've run it in Access 2019, and it works.
Related
I am working on a project where the company still has everything in lotus notes and we're starting redesign the system so they no longer run on Lotus.
Now, I am just trying to import the Lotus tables in an MS Access Database but keep getting the error "Numeric Overflow". Does anyone know how to handle this?
The table has 196 columns and 846 rows. Currently, I have named a range in the lotus table. However, ideally we would be able to just name the range we want to import so:
"SELECT * INTO PRNTDATM FROM [a:a1..a:a8100]"
Full error:
Run-time error '-2147467259(800004005)' Numeric Field overflow
Private Sub Command0_Click()
Dim CombLoop As Integer
Dim LotusCn As Object
Dim rsLotus As Object
Dim strSql, CombFileName, GotoRange As String
Set LotusCn = CreateObject("ADODB.Connection")
Set rsLotus = CreateObject("ADODB.Recordset")
LotusCn.Open "Provider=Microsoft.Jet.OLEDB.4.0; Data Source= K:\GEVS04\NUMBDATM.WK3; Extended Properties=Lotus WK3;"
strSql = "Select * INTO PRNTDATM FROM phil"
rsLotus.Open strSql, LotusCn
LotusCn.Close
Set rsLotus = Nothing
Set LotusCn = Nothing
End Sub
Since this Post i have been working on it and had some improvements i can now read and import some test data to the tables. Found appending worked better than importing whole new table so will have to try that route. Doing this seems to have fixed the overflow issue because i now have the table structure itself already in place as there are only about 5 Table structures that should work fine for this code.
The code is now:
Dim CombLoop As Integer
Dim LotusCn As Object
Dim rsLotus As Object
Dim strSql As String
Dim rs As DAO.Recordset
Set LotusCn = CreateObject("ADODB.Connection")
Set rsLotus = CreateObject("ADODB.Recordset")
LotusCn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=C:\Users\germany5.PLIMSOLL\Desktop\TEST.WK4;" & _
"Extended Properties=Lotus WK4;"
strSql = "SELECT * FROM [a1..C3];"
rsLotus.Open strSql, LotusCn
Set rs = CurrentDb.OpenRecordset("Select * From NICHDATMGECO20;")
If Not (rsLotus.EOF And rsLotus.BOF) Then
FindRecordCount = rsLotus.RecordCount
rsLotus.MoveFirst
Do Until rsLotus.EOF = True
Field1 = rsLotus![Reg. Number]
Field3 = rsLotus![Sales / Tot.Assets]
Field2 = rsLotus![Company Name]
rs.AddNew
rs![Reg. Number] = Field1
rs![Company Name] = Field2
rs.Update
rsLotus.MoveNext
Loop
End If
LotusCn.Close
Set rsLotus = Nothing
Set LotusCn = Nothing
rs.Close
Just to let you know the problem has been solved and above is the end result of the code which works fine for me. I did need to reference Lotus 123 in Tools just in case anyone wants to replicate what Ive done here.
I have tried many ways to get the job done. I am inexperienced with the
Access VBA.
I think the problem is how to set the current database. The code is in a module from another db as the current db. I have paste the code here in a module behind the
currentdb that also gives the same error. I have looked after very much questions.
It must be simple. But I don't see the answer.
Private Sub project()
Dim projectnamen As DAO.Database
Dim strSQL As String
Dim rs As DAO.Recordset
Dim strdbName As String
Dim strMyPath As String
Dim strdb As String
Dim accapp As Object
Path = "c:\GedeeldeMappen\programma en bestanden stiko"
strdbName="projektnamen.accdb"
strMyPath = Path
strdb = strMyPath & "\" & strdbName
'make the db "projectnamen"current. Perhaps this is possible with set??
Set accapp = CreateObject("Access.Application")
accapp.OpenCurrentDatabase (strdb)
'fieldname is naam_van_het_project
'tablename is projectnaam
strSQL = "SELECT All naam_van_het_project FROM projectnaam;"
'here i get an error "can't find the object Select All naam_van_het_project
'FROM projectnaam" error 3011
Set rs = CurrentDb.OpenRecordset(strSQL, dbOpenTable)
rs.MoveFirst
Do While Not rs.EOF
MsgBox (rs)
rs.MoveNext
Loop
End Sub
I think you want to run that query against the db which you opened in the new Access session, accapp.
The CurrentDb method is a member of Application. So qualify CurrentDb with the object variable name of that other application session.
'Set rs = CurrentDb.OpenRecordset(strSQL, dbOpenTable)
Set rs = accapp.CurrentDb.OpenRecordset(strSQL, dbOpenSnapshot)
Note OpenRecordset won't let you use dbOpenTable with a query. So I arbitrarily chose dbOpenSnapshot instead. If that's not what you want, substitute a different constant from the RecordsetTypeEnum Enumeration (see Access help topic for details).
I've successfully connected to my Access database from excel, and can return the contents of the database in a string Using GetString on my RecordSet. GetString prints all of the contents of the table into a message box as I expect it to(in comments below), but GetRows ignores one of the columns(GCAT in this case), which happens to be the only text field in the database. I am trying to print a particular instance of this field into my excel sheet, but at array position(0,1), where the GCAT field should be, it prints the third item of the record, and not the second as I expect. What am I missing? Does it have something to do with it being a text field? Maybe i'm using the wrong library or database engine? Every other column in the database is returned normally.
Sub Connect()
Dim oConn As ADODB.Connection
Dim oRs As ADODB.Recordset
Dim sConn As String
Dim sSQL As String
Dim arrayString As String
sConn = "Provider='Microsoft.ACE.OLEDB.12.0';Data Source='<path_to_db>'; Persist Security Info='False';"
' Open a connection.
Set oConn = New ADODB.Connection
oConn.ConnectionString = sConn
oConn.Open
' Make a query over the connection.
sSQL = "SELECT ID, GCAT, Min_Years, Max_Years, Contract_Price FROM GCAT"
Set oRs = New ADODB.Recordset
CursorLocation = adUseClient
oRs.Open sSQL, oConn, adOpenStatic, adLockBatchOptimistic, adCmdText
GCATArray = oRs.GetRows()
Sheets("Calculations").Range("D6").Value = GCATArray(0, 1)
'GCATString = oRs.GetString()
'MsgBox GCATString
' Close the connection.
oConn.Close
Set oConn = Nothing
End Sub
This is my first foray in VB so I'm both confused and struggling with the language to being with.
Can't see any obvious faults in your code, have you tried debugging yourself? You can loop the fields in the recordset, and display their names for testing like so:
For i = 0 To oRS.Fields.Count -1
debug.print oRS.Fields(i).Name
Next
That way, you can see whether the field you are looking for is actually there in the first place. Next, you can access the field your're after by doing:
Do While Not oRS.EOF
Debug.Print oRS!GCAT
'Exit Do 'if you want to display only the first, break out of the loop here
oRS.MoveNext
Loop
You don't need the GetRows() in this case, that should give you a performance boost too (very noticible on larger recordsets).
I am working on a system that has been in use since the 90's. Written in VB6, it was originally setup to utilize an Access Database and the JET driver.
Now, since we have clients running up against the 2GB file size limit on Access DBs, we are looking into converting everything over to mySQL.
Unfortunately, everything in the system that was written prior to about 5 years ago is using this type of logic:
Dim rst As New ADODB.Recordset
rst.ActiveConnection = cnn
rst.Open "table"
rst.Index = "index"
rst.Seek Array("field1", "field2"), adSeekFirstEQ
rst!field1 = "something new"
rst.Update
The newer code is using SQL commands like SELECT, UPDATE, etc.
So, what we're hoping to do is to phase in the new mySQL DBs for our clients - get them the DB setup but using all the old code.
The problem is that I can't use Index when using the SQL db... everything else seems to work fine except for that.
I get the error: #3251: Current provider does not support the necessary interface for Index functionality.
Is there something I'm missing? Is there another way to so a Seek when using SQL so that I can sort by my Index? Or will I have to go in and change the entire system and remove all the Seek logic - which is used THOUSANDS of times? This is particularly an issue for all of our Reports where we might have a Table with an Index where Col 1 is sorted ASC, Col 2 is sorted DESC, Col 3 is ASC again and I need to find the first 5 records where Col 1 = X. How else would you do it?
Since, as you posted, the DB doesn't support Seek or Index, you're kind of out of luck as far as that is concerned.
However, if you really must use seek /index I'd suggest importing the result of the SQL query into a local .mdb file and then using that to make the recordset work like the rest of the code expects.
This is slightly evil from a performance point of view, and honestly it may be better to replace all the seeks and index calls in the long run anyways, but at least it'll save you time coding.
For creating the local db you can do:
Function dimdbs(Temptable as String)
Dim tdfNew As TableDef
Dim prpLoop As Property
Dim strDbfullpath As String
Dim dbsn As Database
Dim idx As Index
Dim autofld As Field
'PARAMETERS: DBFULLPATH: FileName/Path of database to create
strDbfullpath = VBA.Environ$("TMP") & "\mydb.mdb"
If Dir(strDbfullpath) <> "" Then
Set dbsn = DBEngine.Workspaces(0).OpenDatabase(strDbfullpath)
Else
Set dbsn = DBEngine.CreateDatabase(strDbfullpath, dbLangGeneral)
End If
Set tdfNew = dbsn.CreateTableDef(Temptable)
With tdfNew
' Create fields and append them to the new TableDef
' object. This must be done before appending the
' TableDef object to the TableDefs collection of the
' database.
Set autofld = .CreateField("autonum", dbLong)
autofld.Attributes = dbAutoIncrField
.Fields.Append autofld
.Fields.Append .CreateField("foo", dbText, 3)
.Fields.Append .CreateField("bar", dbLong)
.Fields.Append .CreateField("foobar", dbText, 30)
.Fields("foobar").AllowZeroLength = True
Set idx = .CreateIndex("PrimaryKey")
idx.Fields.Append .CreateField("autonum")
idx.Unique = True
idx.Primary = True
.Indexes.Append idx
Debug.Print "Properties of new TableDef object " & _
"before appending to collection:"
' Enumerate Properties collection of new TableDef
' object.
For Each prpLoop In .Properties
On Error Resume Next
If prpLoop <> "" Then Debug.Print " " & _
prpLoop.Name & " = " & prpLoop
On Error GoTo 0
Next prpLoop
' Append the new TableDef object to the Northwind
' database.
If ObjectExists("Table", Temptable & "CompletedCourses", "Userdb") Then
dbsn.Execute "Delete * FROM " & Temptable & "CompletedCourses"
Else
dbsn.TableDefs.Append tdfNew
End If
Debug.Print "Properties of new TableDef object " & _
"after appending to collection:"
' Enumerate Properties collection of new TableDef
' object.
For Each prpLoop In .Properties
On Error Resume Next
If prpLoop <> "" Then Debug.Print " " & _
prpLoop.Name & " = " & prpLoop
On Error GoTo 0
Next prpLoop
End With
Set idx = Nothing
Set autofld = Nothing
End Function
to find and delete it later you can use the following:
Function DeleteAllTempTables(strTempString As String, Optional tmpdbname As String = "\mydb.mdb", Optional strpath As String = "%TMP%")
Dim dbs2 As Database
Dim t As dao.TableDef, I As Integer
Dim strDbfullpath
If strpath = "%TMP%" Then
strpath = VBA.Environ$("TMP")
End If
strDbfullpath = strpath & tmpdbname
If Dir(strDbfullpath) <> "" Then
Set dbs2 = DBEngine.Workspaces(0).OpenDatabase(strDbfullpath)
Else
Exit Function
End If
strTempString = strTempString & "*"
For I = dbs2.TableDefs.Count - 1 To 0 Step -1
Set t = dbs2.TableDefs(I)
If t.Name Like strTempString Then
dbs2.TableDefs.Delete t.Name
End If
Next I
dbs2.Close
End Function
To import from SQL to that DB you'll have to get the recordset and add each record in using a for loop (unless it's a fixed ODBC connection, i think you can import directly but I don't have example code)
Dim formrst As New ADODB.recordset
Set mysqlconn = New ADODB.Connection
Dim dbsRst As recordset
Dim dbs As Database
'opens the ADODB connection to my database
Call openConnect(mysqlconn)
'calls the above function to create the temp database
'Temptable is defined as a form-level variable so it can be unique to this form
'and other forms/reports don't delete it
Call dimdbs(Temptable)
Me.RecordSource = "SELECT * FROM [" & Temptable & "] IN '" & VBA.Environ$("TMP") & "\mydb.mdb'"
Set dbs = DBEngine.Workspaces(0).OpenDatabase(VBA.Environ$("TMP") & "\mydb.mdb")
Set dbsRst = dbs.OpenRecordset(Temptable)
Set formrst.ActiveConnection = mysqlconn
Call Selectquery(formrst, strSQL & strwhere & SQLorderby, adLockReadOnly, adOpenForwardOnly)
With formrst
Do Until .EOF
dbsRst.AddNew
dbsRst!foo = !foo
dbsRst!bar = !bar
dbsRst!foobar = !foobar
dbsRst.Update
.MoveNext
Loop
.Close
End With
dbsRst.Close
Set dbsRst = Nothing
dbs.Close
Set formrst = Nothing
You'll have to re-import the data on save or on form close at the end, but at least that will only need one SQL statement, or you can do it directly with the ODBC connection.
This is by far less than optimal but at least you can couch all this code inside one or two extra function calls and it won't disturb the original logic.
I have to give huge credit to Allen Browne, I pulled this code from all over the place but most my code probably comes from or has been inspired by his site (http://allenbrowne.com/)
Who wants to use VB6? Nevertheless...
When you do not specify Provider, you can't use Index property. As far as i know only OleDb for MS Jet supports *Seek* method and *Index* property.
Please read this:
Seek method - http://msdn.microsoft.com/en-us/library/windows/desktop/ms675109%28v=vs.85%29.aspx
Index property - http://msdn.microsoft.com/en-us/library/windows/desktop/ms675255%28v=vs.85%29.aspx
ConnectionString property - http://msdn.microsoft.com/en-us/library/windows/desktop/ms675810%28v=vs.85%29.aspx
Provider property - http://msdn.microsoft.com/en-us/library/windows/desktop/ms675096%28v=vs.85%29.aspx
For further information, please see: http://msdn.microsoft.com/en-us/library/windows/desktop/ms681510%28v=vs.85%29.aspx
[EDIT]
After your comments...
I would strongly recommend to download and install Visual Studio Express Edition and use VB.NET instead VB6. Than install ADO.NET MySQL Connector and re-write application, using the newest technology rather than torturing yourself with ADODB objects, etc.
Examples:
Connecting to MySQL databases using VB.NET
[/EDIT]
I have an import which I made with the wizard, at least far enough just to save the specification. It imports CSV files, with headers, quote text qualifiers, and comma delimited. I then use the import specification in some vba that fires from a button click event.
Here are some things I am wondering:
So if the fields in the data are out of order the import fails? if the data does not contain all the fields the import fails? if there are extra fields in the data the import fails?
So is there any kind of validation I can do to the data getting imported th ensure that the fields are the same as the spec, they are in the right order (if they need to be), etc.
This works pretty well, but I just see that if something in the data is out of the normal it will import anyway, and throw the whole time off.
Also....this is not a typical access set up...this is mainly for a team of data analysts to import files into a mdb...there is not an front end with this.
thanks
justin
You can inspect the CSV file using an ADO recordset.
Public Sub InspectCsvFile()
Const cstrFolder As String = "C:\Access\webforums"
Const cstrFile As String = "temp.csv"
Dim i As Integer
Dim strConnect As String
Dim strSql As String
'early binding requires reference, Microsoft ActiveX Data Object Library '
'Dim cn As ADODB.Connection '
'Dim rs As ADODB.Recordset '
'Dim fld As ADODB.Field '
'Set cn = New ADODB.Connection '
'Set rs = New ADODB.Recordset '
'late binding; no reference needed '
Dim cn As Object
Dim rs As Object
Dim fld As Object
Set cn = CreateObject("ADODB.Connection")
Set rs = CreateObject("ADODB.Recordset")
strConnect = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & _
cstrFolder & ";Extended Properties=""text;HDR=Yes;FMT=Delimited"";"
'Debug.Print strConnect '
cn.Open strConnect
strSql = "SELECT * FROM " & cstrFile & ";"
rs.Open strSql, cn
Debug.Print "Fields.Count: " & rs.Fields.Count
For i = 0 To rs.Fields.Count - 1
Set fld = rs.Fields(i)
Debug.Print i + 1, fld.Name, fld.Type
Next i
Set fld = Nothing
rs.Close
Set rs = Nothing
cn.Close
Set cn = Nothing
End Sub
If that connection string doesn't work for you, see Connection strings for Textfile
I would provide them with a protected spreadsheet in the correct format. The protection ensures that they cannot alter it.
Provide them with the error report if/when it fails to import.