I'm looking for a solution to import data from an Excel file into a database (for example: MS Access file).
I can get the idea as well as the structure but because I'm new to something like this it is really hard to finish the work.
Below is my code, which should do these:
Select database
Select import files
Create connection using ADODB
I'm stuck here, using Insert statement to import but how? Because the values to import would be a value of a variable run from the very first cell of Excel files till the end of it.
Please ignore the comment because I'm using my native language to easier understand in future
Sub Import_Data()
'Khai bao bien lien quan den Database
Dim connection As ADODB.connection
Dim record As ADODB.Recordset
'Khai bao cau lenh Query
Dim SQLstr As String
'Khai bao connection string
Dim connectionstring As String
Dim dbstring As String
'Duong dan den file import
Dim fdlg As FileDialog
Application.ScreenUpdating = False
'Chon datafile
With Application.FileDialog(msoFileDialogFilePicker)
.AllowMultiSelect = False
.Filters.Clear
.Filters.Add "Access files", "*.accdb, *.mdb"
If .Show = True Then
datapath = .SelectedItems(1)
Else
Exit Sub
End If
End With
'Chon file import
Set fdlg = Application.FileDialog(msoFileDialogFilePicker)
With fdlg
.AllowMultiSelect = False
.Filters.Clear
.Filters.Add "Excel files", "*.xls,*.xlsx,*.xlsm"
If .Show = True Then
importstring = .SelectedItems(1)
Else
Exit Sub
End If
End With
'Connect to Database
Set connection = New ADODB.connection
With connection
.Provider = "Microsoft.ACE.OLEDB.12.0"
.connectionstring = "Data Source=" & datapath & ";"
.ConnectionTimeout = 30
.Open
If .State = adStateOpen Then
MsgBox "welcome " & Environ("Username") & " ket noi den database"
Else: Exit Sub
End If
End With
Dim a, c As Integer
Dim b, d As Integer
Dim ImpWb As Workbook
Dim ImpWs As Worksheet
Set ImpWb = Application.Workbooks.Open(importstring)
ImpWb.Application.Visible = True
Set ImpWs = ImpWb.Worksheets("Sheet1")
With ImpWs.UsedRange
a = .Rows.Count
b = .Columns.Count
For c = 2 To a
For d = 1 To b
SQLstr = "Insert into Test values(" & Cells(c, d).Value & ")"
connection.Execute SQLstr
Next d
Next c
End With
ImpWb.Close
connection.Close
Set ImpWs = Nothing
Set ImpWb = Nothing
Set connection = Nothing
End Sub
From the comments above it's become clearer now that the issue you face is how to build the SQL statements inside VBA. However, you are very much closer than you think.
This function below will build an insert statement for each row of data provided the columns in the Excel tab is exactly equal to and in exact order as the fields in the SQL table. It also will combine all the inserts into one statement so you can execute all the rows at once.
With ImpWs.UsedRange
a = .Rows.Count
b = .Columns.Count
For c = 2 To a
SQLstr = SQLstr & "INSERT INTO TEST VALUES("
For d = 1 To b
SQLstr = SQLStr & .Cells(c, d).Value & iif(d <> b, ",","")
Next d
SQLstr = SQLStr & ");"
Next c
End With
The other caveat is that assumes all fields are numerical. If you have some text fields you will have to add ' before and after each field, like ' & .Cells(c, d).Value & & '. If you know the columns that need text, you can modify the input with a Select Case on column number as needed.
Hi you recognize or discovered already the magic connection.execute function. Here is the music playing. All its need is a valid SQL string to insert. That's (nearly) all.
SQL Strings can be fired single by single or a bunch separated by a ";" at the end
INSERT INTO table1 (column1,column2 ,..)
VALUES
(value1,value2 ,...),
(value1,value2 ,...),
...
(value1,value2 ,...); --<<<<<<<<<<< see the ";"
In your case you has to define the affected columns in the first line and then just all the values for a line inside the braces. If this do not work - something is wrong with the SQL string. You can use access which has a nice SQL builder to create a sql template or maybe use a online sql tester to see if your sql is valid. For testing purposes i suggest to just add one line first. And another hint: The values has to be escaped ! So add first something trivial like "abc" or 1234 just to check out the principle function. Life datas might have things like this >"< inside or "," or other things which could be seen as sql statement. Which will end up like it will do nothing at all. So read the manual how access escaped such poisoned text fragments ;) And implement a function to avoid that. SQLITE has a nice tutorial and example page. SQLITE is nearly like access. To get a overview i would read there first and the M$ documentation a biut later. Have fun :)
There is also this approach using SQL
Sub test()
Dim c As ADODB.Connection
Dim s As String
Dim strSQL As String
s = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
"Data Source=c:\…...\TestDBs\API_TEST.accdb;" & _
"Persist Security Info=False;"
Set c = New ADODB.Connection
c.ConnectionString = s
c.Open
' Excel workbook, sheet name test1
strSQL = "INSERT INTO tblDestination ( Firstname )" & _
"SELECT [test1$].FirstName " & _
"FROM [EXCEL 12.0;HDR=YES;IMEX=2;DATABASE=C:\Databases\csv\test1.xlsx].[test1$];"
c.Execute strSQL
c.Close
End Sub
Related
I'm struggling with ADO connections/recordsets.
My problem statement is: a function that will return the first value of a chosen field, in a chosen .csv file.
I am doing this to identify variably-named .csv files before adding the data to the relevant tables in a database. I am making the assumption that this field is always present and that either it is consistent throughout the file, or only relevant ones are grouped (this is controlled higher up the chain and is certain enough).
My code is being run as part of a module in an MS Access database:
Public Function GetFirstItem(File As Scripting.File, Field As String)
Dim Conn As ADODB.Connection, Recordset As ADODB.Recordset, SQL As String
Set Conn = New ADODB.Connection
Set Recordset = New ADODB.Recordset
'Microsoft.ACE.OLEDB.16.0 / Microsoft.Jet.OLEDB.4.0
Conn.ConnectionString = "Provider=Microsoft.ACE.OLEDB.16.0;Data Source=""" & File.ParentFolder & _
"""; Extended Properties=""text;HDR=Yes;FMT=Delimited;"";"
SQL = "SELECT " & Field & " FROM """ & File.Name & """ LIMIT 1"
Debug.Print Conn.ConnectionString
Debug.Print SQL
Conn.Open
Recordset.Source = SQL
Recordset.ActiveConnection = Conn.ConnectionString
Recordset.Open
Recordset.MoveFirst
'GetFirstItem = Recordset!Questionnaire
Recordset.Close
Conn.Close
Set Recordset = Nothing
Set Conn = Nothing
End Function
ConnectionString = Provider=Microsoft.ACE.OLEDB.16.0;Data Source="D:\Documents\Jobs\TestPath"; Extended Properties="text;HDR=Yes;FMT=Delimited;";
Field = Questionnaire
SQL = SELECT Questionnaire FROM "test.csv" LIMIT 1
I get an error on Recordset.Open of:
This may be (is probably) down to a complete lack of understanding of how ADO connections/recordsets work. I have tried sans-quotes and it complains about a malformed FROM expression. Additionally, once this hurdle is overcome I am unsure of the syntax of how to return the result of my query. If there is a better way of doing this I am all ears!
Thanks.
In Access you don't need ADO library to query a CSV file:
Public Function GetFirstItem(File As Scripting.File, Field As String) As String
Dim RS As DAO.Recordset, SQL As String
SQL = "SELECT TOP 1 [" & Field & "]" _
& " FROM [" & File.Name & "]" _
& " IN '" & File.ParentFolder & "'[Text;FMT=CSVDelimited;HDR=Yes];"
Debug.Print SQL
Set RS = CurrentDb.OpenRecordset(SQL)
GetFirstItem = RS(0)
RS.Close
Set RS = Nothing
End Function
Usage:
?GetFirstItem(CreateObject("Scripting.FileSystemObject").getfile("c:\path\to\your\file.csv"), "your field")
I'm developping modules on a client XLSm with 32-bits 2013 Excel.
I'd like to use datas on worksheet as if it is an Access table.
With a lot of difficulties, I think connection is now OK.
Still, I have error : 3001 Arguments are of wrong type, are out of acceptable range. Error that I cannot understand.
Here excerpts of VBA lines :
In addition, I added 20 lines in data Worksheet below the header line to permit to Excel to interpret for the type of each columns.
varCnxStr = "Data Source=" & G_sWBookREINVOICingFilePath & ";" & "Extended Properties='Excel 12.0 Xml;HDR=YES;IMEX=15';"
With conXLdb
.Provider = "Microsoft.ACE.OLEDB.12.0"
.Mode = adModeShareExclusive
.Open varCnxStr
End With
strSQL = "SELECT * "
strSQL = strSQL & " FROM [ReInvoiceDB$B2B5072] inum "
strSQL = strSQL & " WHERE inum.InvoiceNum LIKE '1712*' "
strSQL = strSQL & ";"
'>> TRIGGERs ERROR with the current Where Clause !!'
adoXLrst.Open strSQL, conXLdb, dbOpenDynamic, adLockReadOnly, adCmdText
If adoXLrst.BOF And adoXLrst.EOF Then
'no records returned'
GoTo Veloma
End If
adoXLrst.MoveFirst
Do While Not adoXLrst.EOF
'Doing stuff with row'
adoXLrst.MoveNext
Loop
sHighestSoFar = adoXLrst(1).Value '> just to try for RecordSet : Codes are not completed...
sPrefixeCURR = Mid(sHighestSoFar, 1, 4)
Highest = CInt(Mid(sHighestSoFar, 5))
'> Increment >'
Highest = Highest + 1
HighestStr = sPrefixeCURR & Format(Highest, "00")
strGSFNumber = HighestStr
adoXLrst.Close
conXLdb.Close
Veloma:
On Error Resume Next
Set adoXLrst = Nothing
Set conXLdb = Nothing
Exit Sub
Etc.
Any idea about what seems be wrong ?
Thank you
Below is an old example I have been using successfully. Note that the sheet name in the book are Sheet1 and Sheet2, but in the query I had to use sheet1$ and sheet2$. I noticed you had $ signs in the middle of your sheet names. perhaps that's the issue ?
Sub SQLUpdateExample()
Dim con As ADODB.Connection
Dim rs As ADODB.Recordset
Set con = New ADODB.Connection
con.Open "Driver={Microsoft Excel Driver (*.xls)};" & _
"DriverId=790;" & _
"Dbq=" & ThisWorkbook.FullName & ";" & _
"DefaultDir=" & ThisWorkbook.FullName & ";ReadOnly=False;"
Set rs = New ADODB.Recordset
Set rs = con.Execute("UPDATE [Sheet1$] inner join [Sheet2$] on [Sheet1$].test1 = [Sheet2$].test1 SET [Sheet1$].test3 = [Sheet2$].test2 ")
Set rs = Nothing
Set con = Nothing
End Sub
To give more details about the whole module to be implemented : it is to perform a Transaction unit.
This transaction will comprise 3 operations : get a max value from a column (Invoice number) to increment it, record the new number inside an Access table (by DAO), the same Excel file (by ADO) and generating document on HDD.
So it is aimed to use the Excel file as a table not as a file manipulated with Windows script or Excel VBA. My end user is disturbed by the pop-uping of an Excel opening file operation. As a developer, I'm feeling more comfortable with using SQL statements as much as possible inside Transaction session. Is that your opinion too ?
We got some old legacy application which was developed during 2000 and we have moved from access 2003 to 2007. When I am trying to run a module of an application, it is giving me an error:
"Run-time error 3847. ODBCDirect is no longer supported. Rewrite the code to use ADO instead of DAO".
And it highlights to the line Set WS = CreateWorkspace("NewWS", "", "", dbUseODBC). As I am really new to Access, I did research before posting this issue here but no luck. I am trying to rewrite the code to use ADO instead of DAO.
Following is my old vba code:
Public Function GetID (ByRef SegmentItem As clsSegmentDefinitions) As Long
Dim qdf As QueryDef
Dim qdfNewID As QueryDef
Dim rs As Recordset
Dim rsNewID As Recordset
Dim NaturalDescription As String
Dim WS As Workspace
Dim con As Connection
Set WS = CreateWorkspace("NewWS", "", "", dbUseODBC)
WS.DefaultCursorDriver = dbUseODBCCursor
Set con = WS.OpenConnection("", , , SQLConnectString)
DoCmd.Hourglass False
DoCmd.OpenForm " frmQuickAdd_AddNatural ", , , , , acDialog, SegmentItem.AddValue
DoCmd.Hourglass True
If Form_frmQuickAdd_AddNatural.Tag Then
Set qdf = con.CreateQueryDef("", "{ ? = call sp_Insert(?, ?, ?) }")
qdf.Parameters.Refresh
qdf![#prmDescription] = Left(Form_frmQuickAdd_AddNatural.txtSegmentDescription, 34)
qdf![#prmCreateUser] = CurrentUser
qdf![#prmProjectID] = 0
qdf.Execute
Set qdfNewID = CodeDb.CreateQueryDef("")
qdfNewID.Connect = SQLConnectString
qdfNewID.ReturnsRecords = True
qdfNewID.SQL = "sp_GetNewSegmentID"
Set rsNewID = qdfNewID.OpenRecordset
If Not IsNull(rsNewID!MaxOfSegmentID) Then
GetID = rsNewID!MaxOfSegmentID
Else
GetID = 0
End If
Else
GetID = 0
End If
DoCmd.Close acForm, "frmQuickAdd_AddNatural"
End Function
I had started to rewrite code but I have no clue if it is suppose to be like this at all.
Dim cnn As New ADODB.Connection
Dim rst As New ADODB.Recordset
cnn.Open "Provider=mssql;Data Source=" & dbq & ";User Id=" & uid & ";Password=" & pwd
With rst
.Open "SELECT COUNT(*) FROM " & tbl, cnn, adOpenKeyset, adLockOptimistic
num = .Fields(0)
.Close
End With
cnn.Close
Set rst = Nothing
Set cnn = Nothing
First, you really don’t want to introduce ADO into an application built and designed around DAO. Worse, is ADO has been on its way out for about 15 years now. In fact SQL server is dropping support for oleDB which ADO works on. (so don’t go there).
See this link about SQL server dropping oleDB support:
http://blogs.msdn.com/b/sqlnativeclient/archive/2011/08/29/microsoft-is-aligning-with-odbc-for-native-relational-data-access.aspx
The industry has moved away from ADO and all major vendors are suggesting to use Open Database Connectivity as the industry standard. (that means ODBC).
I would create and save a pass-though query in Access. You code can then be re-written as:
Public Function GetID(ByRef SegmentItem As String) As Long
Dim strSQL As String
strSQL = "sp_Insert('" & _
Left(Form_frmQuickAdd_AddNatural.txtSegmentDescription, 34) & "'," & _
"'" & CurrentUser & "', 0)"
With CurrentDb.QueryDefs("qryPass")
.SQL = strSQL
.ReturnsRecords = False
.Execute
End If
With CurrentDb.QueryDefs("qryPass")
.SQL = "sp_GetNewSegmentID"
.ReturnsRecords = True
GetID = Nz(.OpenRecordset()("MaxOfSegmentID"),0)
End With
End Function
So create one pass-though query. And you can use it quite much in all places where you were using JET-DIRECT. In access 2007, jet-direct support was dropped, but use of a simple pass-though query will more than suffice and also as the above shows save buckets of coding and developer time. If the “left” expression you have can return a null, then you likely need to wrap that expression in a nz() to return a “” (null string) or the appropriate value.
I am trying to use the ADO to read in a series of text files into a worksheet. I am running into problems when the majority of the data in a specific column are integers. It will give null values (blank cells) when it reaches a String.
According to microsoft support (Ado mixed data tyes) this is a common thing and the solution is to set the IMEX = 1. I tried this however it didn't work.
I have been searching others threads looking for the answer and came across this answer (other thread) where the author says to change TypeGuessRows to "get the Jet to detect whether a mixed types situation exists and trick the Jet into detecting a certain data type." However, this hasn't worked either.
Below is my VBA code. Any help would be appreciated
Sub query_text_file(WorkingSheet As String, Col As String, Row As Integer, fileName As String, firstOrLast As Integer)
Dim strPath As String
Dim ws As Worksheet
strToolWkbk = fileName
strPath = ThisWorkbook.Path & "\Excel_Barcode_Files"
Set ws = Worksheets(WorkingSheet)
'Need to reference the:
' Microsoft ActiveX Data Objects 2.5 Library
Dim s_rst As ADODB.Recordset
Dim s_cnn As ADODB.Connection 's for sub connection
Dim intRow As Integer
Const adOpenStatic = 3
Const adLockOptimistic = 3
Const adCmdText = &H1
Set s_cnn = New ADODB.Connection
s_cnn = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strPath & ";" _
& "Extended Properties=""text;HDR=Yes;IMEX=1;TypeGuessRows=12;FMT=Delimited"";"
s_cnn.Open
Set s_rst = New ADODB.Recordset
strSQL = "SELECT * FROM " & strToolWkbk
s_rst.Open strSQL, _
s_cnn, adOpenStatic, adLockOptimistic, adCmdText
intRow = Row
s_rst.MoveFirst
Do Until s_rst.EOF
ws.Range(Col & intRow) = s_rst(0)
ws.Range(Chr(Asc(Col) + 1) & intRow) = s_rst(1)
intRow = intRow + 1
s_rst.MoveNext
Loop
s_rst.Close
s_cnn.Close
Set s_rst = Nothing
Set s_cnn = Nothing
End Sub
Here is a sample text file. The code reads in everything except the "P"
test test
P,0
1,1
5,2
6,3
Basically, don't rely on the registry entries as explained here on MSDN.
You need to create a Schema.ini file and put it in the same folder as all your text files. In the Schema.ini you specify the type for all columns you may have in your text files - it's just a much safer option to do that explicitly rather than have the driver work out the correct types for columns...
Say you have some txt files on your desktop, open Notepad and copy paste the below - make sure you adjust the [test.txt] part to match the name of your actual txt file and save it as: Schema.ini
[test.txt]
Format=CSVDelimited
Col1=Column1 Text
Col2=Column2 Text
Make sure you add another slash at the end of the parth in the strPath (also indicated in the article)
strPath = ThisWorkbook.Path & "\Excel_Barcode_Files\"
*Keep in mind that I am working in a different location to yours - I am using my Desktop for this example and my text file is named test.txt
Now, that you have a Schema.ini you can modify the connection string and take out some parameters which are not required because they exists in the Schema.ini
So bascially an SSCCE based on the above assumptions would be:
Sub Main()
Cells.ClearContents
Dim cn As New ADODB.Connection
Dim rs As New ADODB.Recordset
Dim thePath As String
thePath = "C:\Users\" & Environ("USERNAME") & "\Desktop\"
cn.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & thePath & ";" _
& "Extended Properties=""text;HDR=No;"""
cn.Open
Dim sql As String
sql = "SELECT * FROM test.txt"
' populate the recordset
rs.Open sql, cn, adOpenStatic, adLockOptimistic, &H1
' copy the recordset starting at Range("A1") - assuming there are no headers - see HDR = No;
Range("A1").CopyFromRecordset rs
rs.Close
Set rs = Nothing
cn.Close
Set cn = Nothing
End Sub
Now after running this you should see all the values including the missing P:
I have 60 MS Access files with the same database structure. I want to take data from two tables which are in relation from each database to make one single database with all of the records from those 60 files. Is there any easy way to merge all those MS Access files?
If I understand you correctly, you have identical tables spread across 60 database files, and you are looking at a way of automating their aggregation.
There's a few different ways you can do this. It'll probably depend on your circumstances. I've demonstrated two different approaches.
The first method is straightforward. It simply builds a static query, substituting the database name into each query. If your specifics are simplistic - then this should do the trick.
The second method uses DAO to open each table in each database and write the data to the current database. This method is beneficial if you have one-off exceptions and need to add some intelligence.
Public Sub SimpleCombine()
Dim DBFileList As Collection
Dim DBPath As String
Dim ForeignTableName As String
Dim LocalTableName As String
Dim dbfile As Variant
' Configure
Set DBFileList = New Collection
DBFileList.Add "Test1.accdb"
DBFileList.Add "Test2.accdb"
DBPath = CurrentProject.Path ' (No Trailing Backslash)
ForeignTableName = "Fruit"
LocalTableName = "Fruit"
For Each dbfile In DBFileList
querystr = "INSERT INTO Fruit (FruitName, FruitValue) " & _
"SELECT FruitName, FruitValue " & _
"FROM Fruit IN '" & DBPath & "\" & dbfile & "'"
Debug.Print "Transferring Data From " & dbfile
CurrentDb.Execute querystr
DoEvents
Next
End Sub
Example #2
Public Sub DAOCombine()
Dim DBFileList As Collection
Dim DBPath As String
Dim ForeignTableName As String
Dim LocalTableName As String
Dim db As DAO.Database
Dim rst, drst As DAO.Recordset
Dim fld As DAO.Field
' Configure
Set DBFileList = New Collection
DBFileList.Add "Test1.accdb"
DBFileList.Add "Test2.accdb"
DBPath = CurrentProject.Path ' (No Trailing Backslash)
ForeignTableName = "Fruit"
LocalTableName = "Fruit"
Set drst = CurrentDb.OpenRecordset(LocalTableName)
For Each dbfile In DBFileList
Debug.Print "Transferring Data From " & dbfile
Set db = DBEngine.Workspaces(0).OpenDatabase(DBPath & "\" & dbfile)
Set rst = db.OpenRecordset(ForeignTableName)
Do Until rst.EOF
drst.AddNew
For Each fld In rst.Fields
If (fld.Attributes And dbAutoIncrField) = dbAutoIncrField Then
' We have an autonumber field - lets skip
Else
drst.Fields(fld.Name).Value = fld.Value
End If
Next
drst.Update
rst.MoveNext
Loop
rst.Close
DoEvents
Next
drst.Close
Set rst = Nothing
Set drst = Nothing
End Sub
You'll need to tailor the code to your specific circumstances - but it should do the trick.
If the datastructure is the same you can use a JOIN
Query.
SELECT PORDER_ARV.*
FROM PORDER_ARV
UNION
SELECT PORDER_RAN.*
FROM PORDER_RAN
UNION
SELECT PORDER_HOL.*
FROM PORDER_HOL
UNION SELECT PORDER_HIN.*
FROM PORDER_HIN
ORDER BY PURCHASE_CODE;
When you use Union All ,you will also get duplicates, you can write vba code to auto construct this sql string with your 60 table names. I don't no if the union function works with 60 tables?