I use VBA to run an INSERT INTO ... SELECT... SQL query with Currentdb.Execute command. However, I have trouble with the result. There are some rows missing the data.
The result is correct when using Docmd.RunSQL with the same SQL, but I don't want the warning message for inserting data into the table.
I also tried using only the SELECT... with Currentdb.Execute and print the result on the debug window. The result is correct, no missing data.
Here's my code:
strsql = strsql & "INSERT INTO tempLineItems (OrderNo, PositionNo, PartNo, [Description], PlannedDeliveryDate, Qty, Unit, Price, Curr, txta, LineItemText, Discount, Tax) "
strsql = strsql & "SELECT dbo_ttdsls041600.t_orno, dbo_ttdsls041600.t_pono, dbo_ttdsls041600.t_item, IIF(dbo_ttipcs021600.t_dsca is null,dbo_ttiitm001600.t_dsca,dbo_ttipcs021600.t_dsca) AS t_dsca, dbo_ttdsls041600.t_ddta, dbo_ttdsls041600.t_oqua, dbo_ttdsls041600.t_cups, dbo_ttdsls041600.t_pric, dbo_ttdsls040600.t_ccur, dbo_ttdsls041600.t_txta, Null AS LineItemText, dbo_ttdsls041600.t_disc_1, dbo_ttdsls041600.t_cvat "
strsql = strsql & "FROM dbo_ttdsls040600 INNER JOIN ((dbo_ttipcs021600 RIGHT JOIN dbo_ttdsls041600 ON (dbo_ttipcs021600.t_item = dbo_ttdsls041600.t_item) AND (dbo_ttipcs021600.t_cprj = dbo_ttdsls041600.t_cprj)) LEFT JOIN dbo_ttiitm001600 ON dbo_ttdsls041600.t_item = dbo_ttiitm001600.t_item) ON dbo_ttdsls040600.t_orno = dbo_ttdsls041600.t_orno "
strsql = strsql & "WHERE (((dbo_ttdsls041600.t_orno)=" & Me.txtSalesOrderNo.Value & ") AND ((dbo_ttdsls041600.t_pono)>0)) "
strsql = strsql & "ORDER BY dbo_ttdsls041600.t_pono;"
The problem is on the
IIF(dbo_ttipcs021600.t_dsca is null,dbo_ttiitm001600.t_dsca,dbo_ttipcs021600.t_dsca) AS t_dsca
I used ISNULL() function, and it has the same result as using Is Null
3/28/2017 Update:
Those tables are linked tables from the SQL Server. I created local tables based on a subset data of those linked ones, and there's no missing data at all.
Very odd. But I've never had to work much with SQLServer tables. To use RunSQL and not get warnings, turn them off and on.
DoCmd.SetWarnings False
DoCmd.RunSQL ...
DoCmd.SetWarnings True
I'm just curious about this problem, so I did a different approach by using multiple layer of queries.
strsql = strsql & "INSERT INTO tempLineItems (OrderNo, PositionNo, PartNo, Description, PlannedDeliveryDate, Qty, Unit, Price, Curr, txta, LineItemText, Discount, Tax) "
strsql = strsql & "SELECT SO1.t_orno, SO1.t_pono, SO1.t_item, nz(SO1.t_dsca, dbo_ttiitm001600.t_dsca) AS t_dsca, SO1.t_ddta, SO1.t_oqua, SO1.t_cups, SO1.t_pric, SO1.t_ccur, SO1.t_txta, Null AS LineItemText, SO1.t_disc_1, SO1.t_cvat "
strsql = strsql & "FROM (SELECT SO.t_orno, SO.t_ccur, SO.t_pono, SO.t_item, SO.t_oqua, SO.t_pric, SO.t_cups, SO.t_ddta, SO.t_txta, SO.t_disc_1, SO.t_cvat, dbo_ttipcs021600.t_dsca "
strsql = strsql & "FROM (SELECT dbo_ttdsls040600.t_orno, dbo_ttdsls040600.t_ccur, dbo_ttdsls041600.t_pono, dbo_ttdsls041600.t_item, dbo_ttdsls041600.t_pric, dbo_ttdsls041600.t_cups, dbo_ttdsls041600.t_ddta, dbo_ttdsls041600.t_cprj, dbo_ttdsls041600.t_txta, dbo_ttdsls041600.t_disc_1, dbo_ttdsls041600.t_cvat, dbo_ttdsls041600.t_oqua "
strsql = strsql & "FROM dbo_ttdsls041600 INNER JOIN dbo_ttdsls040600 ON dbo_ttdsls041600.t_orno = dbo_ttdsls040600.t_orno "
strsql = strsql & "WHERE (((dbo_ttdsls040600.t_orno)=" & Me.txtSalesOrderNo & "))) SO "
strsql = strsql & "LEFT JOIN dbo_ttipcs021600 ON dbo_ttipcs021600.t_cprj = SO.t_cprj AND dbo_ttipcs021600.t_item = SO.t_item) AS SO1 LEFT JOIN dbo_ttiitm001600 ON dbo_ttiitm001600.t_item = SO1.t_item "
strsql = strsql & "ORDER BY SO1.t_pono;"
And this works!! I guess there's some issue in Access internally.
My problem is, with each iteration of an update loop, I lose about 100k of memory, so eventually, I get an out of resource error after a few thousand iterations.
The question is, why am I losing memory?
Below is a code fragment which is a loop updating data.
The criteria is extracted from a local database, dao.recordset method. -- rs1
The comparison comes from the target database where the update will be done, dao.recordset method. -- rs2 is the target read to see if I need to do an update
The update is a Docmd.Runsql query into a linked sharepoint table. And yes, I know I could use .edit and .update but in that case other strange things happen for a different post. :)
Access 2010 into Sharepoint 2010
Dim db As DAO.Database
Dim rs1 As DAO.Recordset
Dim rs2 As DAO.Recordset
Set db = CurrentDb
Set rs1 = db.OpenRecordset("datefix")
Do While Not rs1.EOF
Set rs2 = db.OpenRecordset("select `Required delivery` from xyzzy where `SO Line` = '" & rs1.Fields(0).Value & "'")
If rs1.Fields(1).Value = rs2.Fields("Required delivery") Then
Else
DoCmd.RunSQL "update ProblemTracking set `Required delivery` = '" & rs1.Fields(1).Value & "', `1st GI Dat` = '" & rs1.Fields(2).Value & "' where `SO Line` = '" & rs1.Fields(0).Value & "'"
End If
rs2.Close
Set rs2 = Nothing
rs1.MoveNext
Loop
Consider converting your VBA recordsets into one stored action query. You see in SQL, JOIN is considered an explicit join and WHERE is considered an implicit join. Optimizers run these two equivalently. And update queries can use join statements. Moreover, stored queries in contrast to VBA queries are analyzed, optimized, and cached by the database with the optimal execution plan stored internally.
If I read your code correctly, you have three tables: datefix, xyzzy, and ProblemTracking all joined by SO Line (and whatever the corresponding column in dateFix as your example uses field numbers and not names). Basically, you need to update the [Required delivery] and [1st GI Dat] fields in ProblemTracking whenever the corresponding second column of dateFix does not equal [Required delivery] in xyzzy.
Hence, consider saving the below Update Query as its own object and running it in VBA with DoCmd.OpenQuery:
UPDATE (ProblemTracking
INNER JOIN datefix ON ProblemTracking.`SO Line` = datefix.`FirstColumn`)
INNER JOIN xyzzy ON xyzzy.`SO Line` = datefix.`FirstColumn`
SET `Required delivery` = datefix.`SecondColumn`, `1st GI Dat` = datefix.`ThirdColumn`
WHERE datefix.SecondColumn <> xyzzy.`Required delivery`
Now if the above is not an updatedatable query, use a DLookUp():
UPDATE ProblemTracking
INNER JOIN datefix
ON ProblemTracking.`SO Line` = datefix.`FirstColumn`
WHERE datefix.SecondColumn <>
DLookUp("[Required delivery]", "xyzzy", "[SO Line]='" & datefix.FirstColumn & "'")
But if you insist on using VBA recordsets, still considering joining all three tables in a SELECT query where you only use one recordset.
Dim db As DAO.Database
Dim rs As DAO.Recordset
Set db = CurrentDb
' PULLING ONLY NEEDED COLUMNS IN JOIN OF THREE TABLES
strSQL = "SELECT datefix.`FirstColumn`, datefix.`SecondColumn`, datefix.`ThirdColumn`" _
& " FROM (ProblemTracking" _
& " INNER JOIN datefix ON ProblemTracking.`SO Line` = datefix.`FirstColumn`)" _
& " INNER JOIN xyzzy ON xyzzy.`SO Line` = datefix.`FirstColumn`" _
& " WHERE datefix.SecondColumn <> xyzzy.`Required delivery`;"
Set rs = db.OpenRecordset(strSQL)
rs.MoveLast
rs.MoveFirst
Do While Not rs.EOF
DoCmd.RunSQL "UPDATE ProblemTracking
SET `Required delivery` = '" & rs.Fields(1).Value & "',
`1st GI Dat` = '" & rs.Fields(2).Value & "'
WHERE `SO Line` = '" & rs.Fields(0).Value & "'"
rs.MoveNext
Loop
rs.Close
Set rs = Nothing
I've inherited some Access VBA code and there are controls on a form (such as a listbox named lstOrderID, mentioned below) which have no RowSource property set (an empty string). I look in the code and find statements like this in various places:
Forms!frm_Customer.lstOrderID = rstCust!OrderID ' set from a record set
Forms!frm_Customer.lstOrderID.Requery
Me.lstOrderID = Me.lstOrderID.ItemData(0) ' set to first item in self
But nowhere in the code is lstOrderID.RowSource being set.
How can Requery be called on a listbox that has no RowSource?
How can a listbox be set to a single value (rstCust!OrderID) from a record set, unless this is a list of values (although the debugger shows an integer in lstOrderID.Value)?
Here is more code:
Dim rstCust As Recordset
Set db = CurrentDb
Set rstCust = db.OpenRecordset("SELECT * FROM Orders WHERE CustID=" & ID & _
"AND Datetaken =Date() " & _
"AND VendorID='" & Forms!frm_Customer.cboVendorID & "'")
Forms!frm_Customer.lstOrderID = rstCust!OrderID
rstCust.Close
db.Close
Another section:
Dim rstCust As Recordset
Dim blStatus As Boolean
Dim strSql As String
Set db = CurrentDb
strSql = "SELECT Orders.OrderID " & _
"FROM Orders " & _
"WHERE (((Orders.DateTaken)=#" & Date & "#) " & _
"AND ((Orders.VendorID)='" & Forms!frm_Customer.cboVendorID & "') " & _
"AND ((Orders.CustID)=" & ID & "));"
Set rstCust = db.OpenRecordset(strSql)
Forms!frm_Customer.lstOrderID = rstCust!OrderID
Forms!frm_Customer.lstOrderID.Requery
Forms!frm_Customer.lstOrderID = rstCust!OrderID
rstCust.Close
db.Close
Also this:
Me.lstOrderID.Requery
Me.lstOrderID = Me.lstOrderID.ItemData(0)
I have very little experience with Access Databases however I have wrote a similar VBA macro in excel. I am trying to copy rows from one .mdb file into the exact same table on a different .mdb file. However I would like it to only import it if it does not already exsist. Could someone please advise me the best way to go about this and maybe some code I can use and modify? I have already looked around stack overflow and can't seem to find any examples that work.
There are 8 different tables and inside these a few hundred rows. with maybe 5-20 columns.
If the script could be made inside VBS this would be ideal, as it would allow me to run the updates without loading into access.
Thanks for any help or advice,
Simon
EDIT -
Zev's answer seems to do the job however I am getting this error, also the MDB inside site2 is the one I am copying from and putting it into site1
Error: Expected end of statement
Code: 800A0401
Line: 17
Char: 13
Code (saved as "update.vbs"):
Dim eng
Set eng = CreateObject("DAO.DBEngine.120")
Set dest = eng.OpenDatabase("C:\Users\simon\Documents\garden games redesign\import script\Site1\ActinicCatalog.mdb")
Sub CopyTable()
Dim rs
Set rs = dest.OpenRecordset("Person")
Dim sWhere
For Each fld In rs.Fields
sWhere = sWhere & " AND " & fld.Name & " <> t1." & fld.Name
Next
sWhere = Mid(sWhere, 6)
Dim sql: sql= _
"INSERT INTO Person " & _
"SELECT * " & _
"FROM Person AS t1 IN ""C:\Users\simon\Documents\garden games redesign\import script\Site2\ActinicCatalog.mdb"" " & _
"WHERE " & sWhere
dest.Execute(sql)
End Sub
Edit for more info:
\Site1\ActinicCatalog.mdb - is destination database
\Site2\ActinicCatalog.mdb - is original database
These databases have about 20 columns
Here is an example to get you started. It copies the content of [Table1] of the current database to [Table1] of a second database.
Option Compare Database
Option Explicit
Sub copyTables()
'Open source database
Dim dSource As Database
Set dSource = CurrentDb
'Open dest database
Dim dDest As Database
Set dDest = DAO.OpenDatabase("C:\Users\Admin\Desktop\DBdest.accdb")
'Open source recordset
Dim rSource As Recordset
Set rSource = dSource.OpenRecordset("Table1", dbOpenForwardOnly)
'Open dest recordset
Dim rDest As Recordset
Set rDest = dDest.OpenRecordset("Table1", dbOpenDynaset)
'Loop through source recordset
While Not rSource.EOF
'Look for record in dest recordset
rDest.FindFirst _
"Field1 = '" & rSource.Fields("Field1") & "' AND " & _
"Field2 = " & rSource.Fields("Field2")
'If not found, copy record - Field1 is text / Field2 is numeric
If rDest.NoMatch Then
rDest.AddNew
rDest.Fields("Field1") = rSource.Fields("Field1")
rDest.Fields("Field2") = rSource.Fields("Field2")
rDest.Update
End If
'Next source record
rSource.MoveNext
Wend
'Close dest recordset
rDest.Close
Set rDest = Nothing
'Close source recordset
rSource.Close
Set rSource = Nothing
'Close dest database
dDest.Close
Set dDest = Nothing
'Close source database
dSource.Close
Set dSource = Nothing
End Sub
I would suggest using an SQL statement if possible. From VBScript using DAO/ACE:
Dim eng
Set eng = CreateObject("DAO.DBEngine.120")
Set dest = eng.OpenDatabase("path\to\destination\database.accdb")
Using ADO:
Dim conn
Set conn = CreateObject("ADODB.Connection")
With conn
.Provider = "Microsoft.ACE.OLEDB.12.0"
.ConnectionString = "Data Source=""path\to\destination\database.accdb"";"
.Open
End With
The SQL statement would be something like this:
INSERT INTO Table1
SELECT *
FROM Table1 AS t1 IN "path\to\source\database.accdb"
WHERE Table1.Field1 <> t1.Field1
and executed like this:
Dim sql = _
"INSERT INTO Table1 " & _
"SELECT * " & _
"FROM Table1 AS t1 IN "path\to\source\database.accdb" " & _
"WHERE Table1.Field1 <> t1.Field1"
'Using DAO or ADO
dest.Execute sql
Considering that each table has a variable number of columns, you might have to generate the WHERE expression dynamically:
Sub CopyTable(tablename)
Dim rs
Set rs = dest.OpenRecordset(tablename)
'if using ADO:
'Set rs = conn.Execute(tablename)
Dim sWhere
For Each fld In rs.Fields
sWhere = sWhere & " AND " & fld.Name & " <> t1." & fld.Name
Next
sWhere = Mid(sWhere, 6)
Dim sql
sql = _
"INSERT INTO " & tablename & " " & _
"SELECT * " & _
"FROM " & tablename & " AS t1 IN ""path\to\source\database.accdb"" " & _
"WHERE " & sWhere
dest.Execute(sql)
End Sub
Update
If you are only using one column to determine whether the record exists, the SQL statement should look like this:
INSERT INTO Table1
SELECT *
FROM Table1 AS t1 IN "path\to\source\database.accdb"
LEFT JOIN Table1 ON t1.FirstField = Table1.FirstField
WHERE Table1.FirstField IS NULL
and CopyTable like this:
Sub CopyTable(tablename)
Dim rs
Set rs = dest.OpenRecordset(tablename)
'if using ADO:
'Set rs = conn.Execute(tablename)
Dim field0Name
field0Name=rs.Fields(0).Name
Dim sql
sql = _
"INSERT INTO " & tablename & " " & _
"SELECT * " & _
"FROM " & tablename & " AS t1 IN ""path\to\source\database.accdb"" " & _
"LEFT JOIN " & tablename & " ON t1." & field0Name & "=" & tablename & "." & field0Name & " " & _
"WHERE " & tablename & "." & field0Name & " IS NULL"
dest.Execute(sql)
End Sub
I want to upload data in to an Access database from csv files using Vb Script & ADO so I don't have to open either Access or Excel.
So Far I have a working script below, but is there a better way to upload the data in one batch without having to create a record set and loop through each record?
I've created an example where I have 2 raw data files (csv) the file People.csv contains the fields 'PERSON' and 'COMPANY' and the other file contains 'COMPANY' and 'STATUS'. The database to be updated has one table 'tblPeople' with the Fields 'PERSON' and 'STATUS'.
Const ST_FILES = "C:\test\Files\"
Const ST_DB = "C:\test\db\mydb.accdb"
'Connection to Raw Files
Dim stCS: stCS = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ST_FILES & _
";Extended Properties=""text;HDR=YES;FMT=Delimited(,)"";"
Dim objCnFiles: set objCnFiles = CreateObject("ADODB.Connection"):objCnFiles.open stCS
'Connection to DB
stCS = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ST_DB
Dim objCnDb: set objCnDb = CreateObject("ADODB.Connection"):objCnDb.Open stCS
'Recordset of Raw Files
Dim objRS: set objRS = CreateObject("ADODB.RecordSet")
Dim stSQL: stSQL = "SELECT T1.PERSON, T2.STATUS " & _
"FROM People#csv T1 " & _
"INNER JOIN Company#csv T2 "& _
"ON T1.COMPANY = T2.COMPANY"
objRS.open stSQL, objCnFiles
'The part Below is the part I want to improve:
'Loops through the recordset inserting record into db line by line.
objRS.MoveFirst
Do until objRS.EOF
stSQL = "INSERT INTO tblPeople (PERSON, STATUS) " & _
"VALUES('" & objRS.Fields("PERSON") & "','" & _
objRS.Fields("STATUS") & "')"
objCnDb.Execute stSQL
objRS.MoveNext
Loop
objRS.close
objCnFiles.close
objCnDb.close
WScript.echo "Done"
WScript.Quit
Edit: Solution Below using the solution provided by Ekkehard.Horner
Const ST_FILES = "C:\test\Files\"
Const ST_DB = "C:\test\db\mydb.accdb"
'Connection to Raw Files
Dim stCS: stCS = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ST_FILES & _
";Extended Properties=""text;HDR=YES;FMT=Delimited(,)"";"
Dim objCnFiles: set objCnFiles = CreateObject("ADODB.Connection"):objCnFiles.open stCS
Dim stSQL: stSQL = "INSERT INTO [tblPeople] IN '" & ST_DB & "'" &_
"SELECT T1.PERSON, T2.STATUS " & _
"FROM People#csv T1 " & _
"INNER JOIN Company#csv T2 "& _
"ON T1.COMPANY = T2.COMPANY"
objCnFiles.Execute stSQL
objCnFiles.close
WScript.echo "Done"
WScript.Quit
Use "INSERT/SELECT INTO IN 'External Database'". For your specific task (text -> mdb,
your query) the statements would look like
Create new table:
SELECT T1.PERSON AS PERSON, T2.STATUS AS STATUS INTO [tblPeople] IN "P:\athto\your.mdb.mdb" FROM [People#csv] T1 INNER JOIN [Company#csv] T2 ON T1.COMPANY = T2.COMPANY
Append to existing table:
INSERT INTO [tblPeople] IN "P:\athto\your.mdb.mdb" SELECT T1.PERSON AS PERSON, T2.STATUS AS STATUS FROM [People#csv] T1 INNER JOIN [Company#csv] T2 ON T1.COMPANY = T2.COMPANY