Every month I have to UPDATE my MS Access db from approximately 30 excel files. They have all the same structure and format. I try to modify this code several times to update each tables in my db in once but i didn't succeed. (found in this forum)
I have 3 questions:
How is it possible to say to the vba code to look at this range in the excel template which correspond to this column in the MS Access db?
How can i make this vba code update all the tables in once based on the Primary Key?
Then, Is it possible to select the Folder where all these excel files are and the code will loop through all files?
Public Sub UpdatePriceList()
Dim cn As ADODB.Connection, rs As ADODB.Recordset
Dim sProduct As String, sVariety As String, cPrice As Variant
' connect to the Access database
Set cn = New ADODB.Connection
cn.Open "Provider=Microsoft.ACE.OLEDB.12.0; " & _
"Data Source=C:\Users\Gord\Desktop\Database1.accdb;"
' open a recordset
Set rs = New ADODB.Recordset
rs.Open "PriceList", cn, adOpenKeyset, adLockOptimistic, adCmdTable
Range("A2").Activate ' row 1 contains column headings
Do While Not IsEmpty(ActiveCell)
sProduct = ActiveCell.Value
sVariety = ActiveCell.Offset(0, 1).Value
cPrice = ActiveCell.Offset(0, 2).Value
rs.Filter = "product='" & sProduct & "' AND variety='" & sVariety & "'"
If rs.EOF Then
Debug.Print "No existing record - adding new..."
rs.Filter = ""
rs.AddNew
rs("product").Value = sProduct
rs("variety").Value = sVariety
Else
Debug.Print "Existing record found..."
End If
rs("price").Value = cPrice
rs.Update
Debug.Print "...record update complete."
ActiveCell.Offset(1, 0).Activate ' next cell down
Loop
rs.Close
Set rs = Nothing
cn.Close
Set cn = Nothing
End Sub
thank you in advance!
If you know how to deal with a single excel file and convert it to acess table and all the rest of file will be treated the same way. You can use a bot which will automate the task and do it quickfast. You just have to give it the "instruction" how to deal with single file and it will do the rest.
The instruction can be as simple as a notepad file with table containing the mouse positions and the stroken keyboards key necessary to deal with one file.
You may use "Autoit V3 script"
Related
I am parsing a worksheet into Access using the following code:
Sub LoadRates(ByRef TimesheetFile As Excel.Workbook)
On Error GoTo LoadDataCollection_Error
Dim i As Integer
Dim LastRow As Integer
Dim shRates As Excel.Worksheet
Set shRates = TimesheetFile.Worksheets("Rates")
shRates.ShowAllData
LastRow = shRates.Cells(shRates.Rows.Count, 1).End(xlUp).Row
shRates.Cells(1, 4).value = "Current"
Dim db As DAO.Database
Set db = CurrentDb
Dim strSQL As String
Dim dbWb As String
dbWb = "[Excel 12.0;HDR=YES;IMEX=1;Database=" & TimesheetFile.FullName & "].[Rates$A1:i" & LastRow & "]"
strSQL = "SELECT A.[Entity no] AS Entity,Staff AS Name, A.Current as Rates, Company, [2015 BCTC category] AS BCTC_Category,[2015 Rating] As Rating " & _
" INTO fromTimesheet " & _
" FROM " & dbWb & " AS A "
db.Execute strSQL, dbFailOnError
Exit Sub
LoadDataCollection_Error:
... do stuff...
End Sub
my problem is that I have to change the column 4's header to "Current" manually because the title is currently a date value, thus inappropriate for SQL to pick up
shRates.Cells(1, 4).value = "Current"
when I execute this code. sometimes it returns an error message saying it cannot find the field A.Current , and other times it would be able to find it. Is this caused by the workbook being set to Shared?
Any help would be appreciated.
Upon testing, I found out that this error has to do with the excel workbook being "Shared". Once I made the workbook exclusive, the code was able to pick up me editing the row value.
This leads me to believe that when I instantiate an excel workbook object that is being shared. It should be treated as read-only.
Hopefully this is helpful for others.
Yes, your column header is not being effectively saved and connection is using last saved instance.
Consider manually saving it after you make your change. Also, be sure you have write access to save workbook and not in shared/read-only (or alternatively save a different temp workbook for import):
shRates.Cells(1, 4).value = "Current"
TimesheetFile.Save
But also consider using DoCmd.TransferSpreadshet method instead of worksheet connection (which can facilitate "shared" process). Usually one uses a true database for connection and not flatfiles like spreadsheets.
Sub LoadRates(ByRef TimesheetFile As Excel.Workbook)
On Error GoTo LoadDataCollection_Error
Dim i As Integer, LastRow As Integer
Dim shRates As Excel.Worksheet
Set shRates = TimesheetFile.Worksheets("Rates")
shRates.ShowAllData
LastRow = shRates.Cells(shRates.Rows.Count, 1).End(xlUp).Row
shRates.Cells(1, 4).value = "Current"
TimesheetFile.Close True ' SAVES AND CLOSES
DoCmd.TransferSpreadsheet acImport, "fromTimesheet", _
TimesheetFile.FullName, True, "Rates!"
Exit Sub
LoadDataCollection_Error:
... do stuff...
End Sub
I have code written to pull a specific file from a folder, insert it into an attachment field (local_attachment) and which creates a new record in table TEMP_attachment. I am trying to pull all the files from a folder and have them each be a new record in the table but I keep running into issues where I either pull all the files and they all go into one record, or it won't pull any. Thank you for your help!!!
Here is my code:
Dim x As Long
Dim strFile As String
Dim db As DAO.Database
Dim rs As DAO.Recordset2
Dim rsA As DAO.Recordset2
Dim fld As DAO.Field2
Dim SQL As String
x = 1
strFile = "C:\dev\test_file2.txt"
SQL = "INSERT INTO TEMP_Attachment (ID) "
SQL = SQL & "VALUES (" & x & ")"
DoCmd.RunSQL SQL
Set db = CurrentDb
Set rs = db.OpenRecordset("TEMP_Attachment")
Set fld = rs("local_attachemnt")
'Navigate through the table
Set rsA = fld.Value
rs.Edit
rsA.AddNew
rsA("FileData").LoadFromFile strFile
rsA.Update
rs.Update
The problems with your code can be fixed my taking a more methodical approach. As I see it, you need to find all the files in the folder, add a record for each one, add an attachment record for the file, read the file data into the new record, and generate a unique key for the parent record.
Rather than try to do everything at once, let's break into pieces and take them in reverse order, so we're dealing with the smallest problems first:
First, let's figure out how we are going to generate a key. The easiest way to do this is to use an Autonumber field. Rather than cook up something fancier, I'm going to assume this is the solution you will use. This will make DoCmd.RunSQL unnecessary and simplify the whole operation.
Second, write a routine which adds one file to one record in the database, and make sure this is working. My suggestion would be to create parameters for a recordset to the main table and a path to the file, like so (I have not tested this, that will be your job. I've added error handlers to help you work out any issues):
Private Sub AddFileAttachment(ByRef rs As DAO.Recordset, ByVal sPath As String)
Dim rsAttachments As DAO.Recordset
On Error Goto EH
With rs
'(this will generate a new Autonumber in the main table)
.AddNew
'this will create a new attachment in the field and add it
Set rsAttachments = .Fields("local_attachemnt").Value
With rsAttachments
.AddNew
.Fields("FileData").LoadFromFile sPath
.Update
.Close
End With
'this is what adds the main record
.Update
End With
EH:
With Err
MsgBox .Number & vbcrlf & .Source & vbCrLf & .Description
End With
FINISH:
If Not rs Is Nothing Then
rs.Close
Set rs = Nothing
End If
If Not rsAttachments Is Nothing Then
rsAttachments.Close
Set rsAttachments = Nothing
End If
End Sub
And call it like so:
Private Sub cmdTest_Click()
Dim db As DAO.Database
Dim rs As DAO.Recordset
On Error Goto EH
Set db = CurrentDb
Set rs = db.OpenRecordset("TEMP_Attachment")
AddFileAttachment rs, "C:\dev\test_file2.txt"
Goto FINISH
EH:
With Err
MsgBox .Number & vbcrlf & .Source & vbCrLf & .Description
End With
FINISH:
rs.Close
End Sub
Important! Perfect the first routine before moving on. You should test it until you know it works over and over. You should be able to click the button it is attached to 10 times and each time get a new record with the file attached.
Once you know this is working, you are ready to write the main routine that calls it for each file you are attaching. I will not include that here, but would suggest researching the FileSystemObject. You should be able to find a lot of vba examples for how to get all the files in a folder. You would loop through them and call your routine for each file the same way it is called in the test above, passing in the open recordset.
I have been struggling to transfer data from multiple excel worksheets into multiple access tables. So how this goes is this way. I have 5 worksheets and each of this worksheet is to be transferred from Excel into a specific Access table. How do I do this using VBA?
I cant seem to put the file in so I hope you guys understand!
Thanks in advance for helping me!!
You can use ADO. First, set a reference to the ADO library in the VBE: Tools, References. Look for Microsoft ActiveX Date Objects Library 6.1 (or 6.0) and tick the box next to it.
Then you can use the code below to post data from a sheet to a table in the Access database (use this in a loop if you want to do multiple sheets):
Dim i As Long, j As Long
Dim cn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim arr() As Variant
'Load the data from a sheet into an array
arr = Sheets(1).Range("A2:B10").Value
'Connect to Access database
Set cn = New ADODB.Connection
With cn
.ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=C:\Documents\Database1.accdb"
.Open
End With
'Post data to table
Set rs = New ADODB.Recordset
With rs
.Source = "Table1"
.ActiveConnection = cn
.CursorType = adOpenStatic
.CursorLocation = adUseServer
.LockType = adLockOptimistic
.Open
For i = 1 To UBound(arr, 1)
.AddNew
For j = 1 To UBound(arr, 2)
.Fields(j).Value = arr(i, j) 'This assumes you have an autonumber ID field. (Field indexes in recordsets are 0 based.)
Next
.Update
Next
.Close
End With
'Clean up
Set rs = Nothing
cn.Close
Set cn = Nothing
EDIT:
If you want to check if a record already exists in the table, use the recordset FILTER property. Say you have an "ID" in column 1 of your spreadsheet and an "ID" field in your database table, then do:
rs.Filter = "ID='" & arr(1,j) & "'"
If rs.RecordCount > 0 then
'Record(s) already exist
...
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'm trying to import tables from a FoxPro 9.0 database into Access 2003. So far, from Google searches and many trials, the only way for me to connect to the tables is through an OLE DB connection programatically. I have set up 3 ODBC connections with different configurations but none of them work: I get "unspecified errors" that I can't find any information on.
With OLE DB I can succesfully connect to the FoxPro database, and import tables in ADO recordsets. The problem is that I can't save the recordset into new table in the local database using SQL. The ADO recordsets behave differently than tables, so I can't query them. The code below gives me a "type mismatch" error at DoCmd.RunCommand ("select * from " & rst & " INTO newClients").
Sub newAdoConn()
Dim cnn As ADODB.Connection
Dim rst As ADODB.Recordset
Dim strSQL As String
Dim decision As Integer
Set cnn = New ADODB.Connection
cnn.ConnectionString = "Provider=vfpoledb;" & _
"Data Source=s:\jobinfo\data\jobinfo.dbc;" & _
"Mode=ReadWrite|Share Deny None;" & _
"Collating Sequence=MACHINE;" & _
"Password=''"
strSQL = "Select * from Jobs"
cnn.Open
Set rst = cnn.Execute("Select * from clients")
If rst.EOF = False Then
Do While Not rst.EOF
decision = MsgBox(rst.Fields!ID & " " & rst.Fields!fname & " " & rst.Fields!lname & vbCrLf & vbCrLf & "Continue?", vbYesNo)
If decision = vbYes Then
rst.MoveNext
Else
Exit Do
End If
Loop
End If
DoCmd.RunCommand ("select * from " & rst & " INTO newClients")
rst.Close
Set rst = Nothing
cnn.Close
Set cnn = Nothing
End Sub
I finally worked out a decent solution. It involves saving the ado recordset from memory to an excel file using the copyFromRecordset function, and then linking the file programmatically to a table in excel using the TransferSpreadsheet()...
Sub saveToExcel()
Dim cnn As ADODB.Connection
'declare variables
Dim rs As ADODB.Recordset
Dim strSQL As String
Dim decision As Integer
Dim colIndex As Integer
' Dim fso As New FileSystemObject
' Dim aFile As File
'set up connection to foxpro database
Set cnn = New ADODB.Connection
cnn.ConnectionString = "Provider=vfpoledb;" & _
"Data Source=s:\jobinfo\data\jobinfo.dbc;" & _
"Mode=ReadWrite|Share Deny None;" & _
"Collating Sequence=MACHINE;" & _
"Password=''"
cnn.Open
Set rs = cnn.Execute("Select * from clients")
'Create a new workbook in Excel
Dim oExcel As Object
Dim oBook As Object
Dim oSheet As Object
Set oExcel = CreateObject("Excel.Application")
Set oBook = oExcel.Workbooks.Add
Set oSheet = oBook.Worksheets(1)
oSheet.Name = "clients"
' Copy the column headers to the destination worksheet
For colIndex = 0 To rs.Fields.Count - 1
oSheet.Cells(1, colIndex + 1).Value = rs.Fields(colIndex).Name
Next
'Transfer the data to Excel
oSheet.Range("A2").CopyFromRecordset rs
' Format the sheet bold and auto width of columns
oSheet.Rows(1).Font.Bold = True
oSheet.UsedRange.Columns.AutoFit
'delete file if it exists - enable scripting runtime model for this to run
'If (fso.FileExists("C:\Documents and Settings\user\Desktop\clients.xls")) Then
' aFile = fso.GetFile("C:\Documents and Settings\user\Desktop\clients.xls")
' aFile.Delete
'End If
'Save the Workbook and Quit Excel
oBook.SaveAs "C:\Documents and Settings\user\Desktop\clients.xls"
oExcel.Quit
'Close the connection
rs.Close
cnn.Close
MsgBox ("Exporting Clients Done")
'link table to excel file
DoCmd.TransferSpreadsheet acLink, acSpreadsheetTypeExcel5, "clientsTest", "C:\Documents and Settings\user\Desktop\clients.xls", True
End Sub
What you will have to do is open the FoxPro table as a recordset and open the local table as another recordset. You can then loop through the FoxPro recordset and do something like this
Do until FoxProRst.EOF
LocatRst.AddNew
LocalRst!SomeField1=FoxProRst!SomeField1
LocalRst!SomeField2=FoxProRst!SomeField2
LocalRst!SomeField3=FoxProRst!SomeField3
LocalRst.Update
FoxProRst.MoveNext
Loop
It might not be the quickest way but it will work
Let me just sketch another approach with SQL queries, that could simplify:
'...
'not required for first time test:
'cnn.Execute("DROP TABLE MyNewTable")
'...
'create the new table in the destination Access database
cnn.Execute("CREATE TABLE MyNewTable (MyField1 int, MyField2 VARCHAR(20), MyField3 Int)")
'insert data in the new table from a select query to the original table
Dim sSQL as string, MyOriginalDBPath as String
sSQL = "INSERT INTO MyNewTable (MyField1, MyField2, MyField3) SELECT OriginalField1, OriginalField2, OriginalField3 FROM [" & MyOriginalDBPath & ";PWD=123].clients"
Dim rs As ADODB.Recordset
Set rs = New ADODB.Recordset
rs.Open sSQL, cnn, adOpenForwardOnly, adLockReadOnly, adCmdText
'...
Note: this 'draft' idea assumes that the connection string is made to the Access database and the connection to the original database would be inside the SQL string, but i have not idea about the correct sintaxis. I have only tested this approach with different access databases.
Note that this is for Access: ...[" & MyOriginalDBPath & ";PWD=123]...
The Jet database engine can reference external databases in SQL statements by using a special syntax that has three different formats:
[Full path to Microsoft Access database].[Table Name]
[ISAM Name;ISAM Connection String].[Table Name]
[ODBC;ODBC Connection String].[Table Name]
...
You can use an ODBC Data Source Name (DSN) or a DSN-less connection string:
DSN: [odbc;DSN=;UID=;PWD=]
DSN-less: [odbc;Driver={SQL Server};Server=;Database=;
UID=;PWD=]
Some references:
Querying data by joining two tables in two database on different servers
C# - Join tables from two different databases using different ODBC drivers
Why not use ODBC to link to the table? http://support.microsoft.com/kb/225861