i am trying to copy a collection database in vba to access 2010 database, below is a code that works. But what i want to know is if there is some easier or quicker way of doing this especially when i am going to have large no or fields and records.
Dim plist As New partlist 'plist is a class
Dim plcol As New Collection
Sub DBInsert1()
' this function will add add 2 records from a collection to access database
Dim DB As DAO.Database
Dim RS As DAO.Recordset
plist.itemno = "1"
plist.itemname = "one"
plcol.Add plist
Set plist = Nothing
plist.itemno = "2"
plist.itemname = "two"
plcol.Add plist
'above plcol collection has a set of info
' open database
Set DB = DAO.OpenDatabase("D:\tblImport.accdb")
' open table as a recordset
Set RS = DB.OpenRecordset("Table1")
For Each plist In plcol
' add a record to the recordset
RS.AddNew
RS.Fields("itemno") = plist.itemno
RS.Fields("itemname") = plist.itemname
' write back recordset to database
RS.Update
Set plist = Nothing
Next
' important! cleanup
RS.Close
' forget to close the DB will leave the LDB lock file on the disk
DB.Close
Set RS = Nothing
Set DB = Nothing
End Sub
you could try an ADO connection to the DB www.connectionstrings.com and https://support.microsoft.com/en-us/kb/168336
CONNECTION.execute "INSERT INTO Table1 (itemno,itemname) values('" & plist.itemno & "','" & plist.itemname & ')"
Related
I'm in the process of moving all the Lotus sheets a company has to a SQL Server and I am using MS Access tables as an intermediary.
This code has been working fine for sheets that are not named but I've come across about 2300 or so sheets where it's named numb. There are too many files for me to manually change them all.
The error I am getting is:
Run-Time error '-2147217865(80040e37)':
The Microsoft Jet Database engine could not find the object "numb:A1..numb:A8000". Make sure the object exists and that you spell its name and the path name correctly.
Found this site but that hasn't provided the answer
I've seen different options for getting the destination right on an ADOB call ("SELECT * FROM [numb:A1..numb:A8000];" or ("SELECT * FROM [numb$:A1..numb$:A8000];") and those haven't worked.
Here is the functioning code when the sheet isn't named:
Dim rst As DAO.Recordset
Dim rs As DAO.Recordset
Dim LotusCn As Object
Dim rsLotus As Object
'Read WK3 Lotus files
repcode = rs![Code]
Directory = rs![Directory]
Directory = Directory & "NUMDATM.WK3"
Set LotusCn = CreateObject("ADODB.Connection")
Set rsLotus = CreateObject("ADODB.Recordset")
'This creates the objects for the lotus connctions
'below the connection string
LotusCn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & Directory & ";" & _
"Extended Properties=Lotus WK3;Persist Security Info=False"
strSQL = "SELECT * FROM [A1..A8000];" 'The SQL to pick the right sections of the lotus file. Picks the Latest Available Date
rsLotus.Open strSQL, LotusCn, adOpenStatic '<<< ***Error occurs here***
If Not (rsLotus.EOF And rsLotus.BOF) Then
FindRecordCount = rsLotus.RecordCount
rsLotus.MoveFirst
Do Until rsLotus.EOF = True
Debug.Print rsLotus.Fields(0).Value
If Len(rsLotus.Fields(0).Value) > 0 Then
rst.AddNew
rst!RegNo = rsLotus.Fields(0).Value
rst.Update
End If
rsLotus.MoveNext
Loop
End If
LotusCn.Close
strSQL = ""
Set rsLotus = Nothing
Set LotusCn = Nothing
Does anyone know how to get named spreadsheets?
I dont know exactly how in Lotus but this was in Excel
Set oRs = oConn.OpenSchema(adSchemaTables) 'get the name of the sheet in Excel
oRs.MoveFirst
With oRs
While Not .EOF
If .fields("TABLE_TYPE") = "TABLE" Then
Debug.Print .fields("TABLE_NAME")
If VBA.Len(.fields("TABLE_NAME")) = 9 Then
WSnameTBL = .fields("TABLE_NAME")
Else
End If
' WSnameTBL = VBA.Replace(WSnameTBL, "$", "", 1, , vbTextCompare)
End If
.MoveNext
Wend
End With
I would like to be able to see a line of text in a textbox from an access database.
I know how to write and delete data from the database through visual basic code, but how can you read data?
If for example, I have something that says "Hi" saved in my database. How can I use a line of code in visual basic to read "Hi" and then show it in a textbox or simply in the console app?
Sub SayHi()
Dim dbs As DAO.Database
Dim rst As DAO.Recordset
Dim strCity As String
Set dbs = CurrentDb
Set rst = dbs.OpenRecordset("SELECT Foo FROM tblCustomers WHERE Foo = " & "'Hi'")
'Begin row processing
Do While Not rst.EOF
MsgBox rst!Foo
Loop
'Cleanup
rst.Close
Set rst = Nothing
End Sub
I'm trying to create a table in Access that holds the current users computer name that are in the system.
The code I have so far is
Option Compare Database
Option Explicit
Sub ShowUserRosterMultipleUsers()
Dim cn As New ADODB.Connection
Dim rs As New ADODB.Recordset
Dim i, j As Long
Set cn = CurrentProject.Connection
Dim dbs As Database, tbl As TableDef, fld As Field
Set dbs = CurrentDb
Set tbl = dbs.CreateTableDef("Users")
Set fld = tbl.CreateField("User#", dbText)
' The user roster is exposed as a provider-specific schema rowset
' in the Jet 4.0 OLE DB provider. You have to use a GUID to
' reference the schema, as provider-specific schemas are not
' listed in ADO's type library for schema rowsets
Set rs = cn.OpenSchema(adSchemaProviderSpecific, _
, "{947bb102-5d43-11d1-bdbf-00c04fb92675}")
'Output the list of all users in the current database.
Debug.Print rs.Fields(0).Name, "", rs.Fields(1).Name, _
"", rs.Fields(2).Name, rs.Fields(3).Name
While Not rs.EOF
Debug.Print rs.Fields(0), rs.Fields(1), _
rs.Fields(2), rs.Fields(3)
rs.MoveNext
Wend
tbl.Fields.Append ?
End Sub
The code I found and updated a bit works, but it only outputs to the immediate window, which the debug.print should, but I need to create a table with all the data.
Any help would be appreciated.
Thanks in advance.
Got it, funny thing this has been asked before on this site, will have to try searching better next time.
my code which works is as follows
Option Compare Database
Option Explicit
Sub ShowUserRosterMultipleUsers()
Dim cn As New ADODB.Connection
Dim rs As New ADODB.Recordset
Dim i, j As Long
Dim db As Database
Dim rsDao As DAO.Recordset
Set cn = CurrentProject.Connection
Set db = CurrentDb
Set rsDao = db.OpenRecordset("Users", dbOpenTable, dbAppendOnly + dbFailOnError)
' The user roster is exposed as a provider-specific schema rowset
' in the Jet 4.0 OLE DB provider. You have to use a GUID to
' reference the schema, as provider-specific schemas are not
' listed in ADO's type library for schema rowsets
Set rs = cn.OpenSchema(adSchemaProviderSpecific, _
, "{947bb102-5d43-11d1-bdbf-00c04fb92675}")
'Output the list of all users in the current database.
Do While Not rs.EOF
rsDao.AddNew
rsDao!User.Value = rs.Fields(0)
rsDao.Update
rs.MoveNext
Loop
End Sub
This assumes you have a database with a table named "Users" with a column in it called "User", very original I know.
Tested it and it brings in the one user me, and it should bring in any others that are in the database as well.
Thanks for all your help Ken.
I have been searching for a way of duplicating or copying a recordset in VBA. And by that I mean, having the undelying data independent of each other.
I have tried
Set copyRS = origRS.Clone
Set copyRS = origRS
When I use any of the methods I cant modify one recordset without modifying the other. So in this example:
I create a recordset
I populate the recordset with the name John
I clone the recordset
I modify the cloned one
Check result
Code:
Dim origRS As Recordset, copyRS As Recordset
Set origRS = New Recordset
'Create field
origRS.Fields.Append "Name", adChar, 10, adFldUpdatable
origRS.Open
'Add name
origRS.AddNew "Name", "John"
'Clone/copy
Set copyRS = origRS.Clone
'Change record in cloned/copied recordset
copyRS.MoveFirst
copyRS!Name = "James"
'This should give me "JamesJohn"
MsgBox copyRS.Fields(0).Value & origRS.Fields(0)
But unfortunately for me, this modifies both recordsets
My question is:
Is there a way of copying a recordset from another recordset and then modify the data independently of each other (without looping)?
I know that evidently you can do it through a loop, but is there no other way?
++ Good question! btw. this way of copying object is called a deep copy.
I usually get away with creating an ADODB.Stream and saving the current recordset into it.
Then you can use the .Open() method of a new recordset and pass the stream to it.
For example:
Sub Main()
Dim rs As ADODB.Recordset
Set rs = New ADODB.Recordset
rs.Fields.Append "Name", adChar, 10, adFldUpdatable
rs.Open
rs.AddNew "Name", "John"
Dim strm As ADODB.Stream
Set strm = New ADODB.Stream
rs.Save strm
Dim copy As New ADODB.Recordset
copy.Open strm
copy!Name = "hellow"
Debug.Print "orignal recordset: " & rs.Fields(0).Value
Debug.Print "copied recordset: " & copy.Fields(0).Value
strm.Close
rs.Close
copy.Close
Set strm = Nothing
Set rs = Nothing
Set copy = Nothing
End Sub
Results as expected:
I've successfully used ExcelADO for reading and importing Excel data into MSAccess during long time reading the entire SpreadSheet.
This time I need to import some table objects that can coexist with other table objects in the same spreadsheet.
According to the documentation http://support.microsoft.com/kb/278973, the only thing that needs to be changed is the From clause in the SQL string:
oRS.Open "Select * from Table1", oConn, adOpenStatic
However this fails and shows the error number mentioned in the title of this thread that essentially says that the object Table1 does not exists in that spreadsheet.
The complete code I'm using is this:
Private Sub Command0_Click()
Const adOpenStatic = 3
Const adLockOptimistic = 3
Const adCmdText = &H1
Dim cnn As ADODB.Connection
Dim rst As ADODB.Recordset
Dim dbs As DAO.Database
Set dbs = CurrentDb
Set cnn = New ADODB.Connection
Set rst = New ADODB.Recordset
cnn.Open "Provider=Microsoft.ACE.OLEDB.12.0;" & _
"Data Source=C:\MyPath\MyFile.xlsx;" & _
"Extended Properties= 'Excel 12.0;HDR=Yes';"
rst.Open "Select * From Table1", _
cnn, adOpenStatic, adLockOptimistic, adCmdText
With rst
If Not .EOF And Not .BOF Then
Do Until .EOF
Debug.Print .Fields(0), .Fields(1), .Fields(2)
.MoveNext
Loop
End If
End With
Set rst = Nothing
Set cnn = Nothing
Set dbs = Nothing
End Sub
As I said I can retrieve the whole content of the spreadsheet using:
.Open "Select * From [Sheet1$]", oConn, adOpenStatic
Also I can get the contents of a specified range:
.Open "Select * From [Sheet1$A1:B10]", oConn, adOpenStatic
I double-checked for the existence of that object using VBA, and it's there:
Private Sub Command2_Click()
Dim xlAp As Excel.Application
Dim xlWb As Excel.Workbook
Dim i As Long
Set xlAp = New Excel.Application
Set xlWb = xlAp.Workbooks.Open("C:\MyPath\MyFile.xlsx")
For i = 1 To xlWb.ActiveSheet.ListObjects.Count
Debug.Print xlWb.ActiveSheet.ListObjects(i).Name, _
xlWb.ActiveSheet.ListObjects(i).DisplayName
Next i
Set xlWb = Nothing
Set xlAp = Nothing
End Sub
Does anybody know how to solve this issue?
Thanks in advance,
Diego
Edit:
Well, the error is right in the sense that my object Table1 is not present in the schema as evaluated by using:
Set rs = cnn.OpenSchema(adSchemaTables)
With rs
If Not .EOF And Not .BOF Then
Do Until .EOF
Debug.Print rs.Fields(0), _
rs.Fields(1), _
rs.Fields(2), _
rs.Fields(3)
.MoveNext
Loop
End If
End With
Set rs = Nothing
nor in the tables catalog:
Dim cat As ADOX.Catalog
Dim tbl As ADOX.Table
Set cat = New ADOX.Catalog
cat.ActiveConnection = cnn
For Each tbl In cat.Tables
Debug.Print tbl.Name, tbl.Type
Next tbl
Set cat = Nothing
That's strange considering that the documentation explicitly says:
Named ranges are treated as "Tables" and worksheets are treated as "System Tables,"
So my guess is that Excel 2013 x64 stores named ranges in a different way than before and for accessing them via ExcelADO the syntax needs to be modified in the best scenario or they cannot accessed this way anymore.
As I previously said, the named ranges exist in my spreadsheet and I can loop through them using the range object via automation.
Hopefully someone has an answer to this.
All the best,
Diego
Environ: Windows 7 x64, Access 2013 x64, Excel 2013 x64.
Norie from utteraccess put me in the right path:
In Excel ListObjects aren't named ranges, and what you have is a
ListObject so it's not going to appear in the schema.
So this has nothing to do with the change in the object model; listobjects and named ranges are just different objects even if they appear almost the same for the user.
Didn't find an answer yet for dealing with ListObjects via ExcelAdo, but since that's another question I leave it here: ExcelADO: Fill recordset with ListObject
I have facing the same issue too. I have named range on another sheet that I can query using the named range.
When I open my Name Manager, there is sheets name that have single quote on the name, then query using named range on this sheet will not working.
Then I rename my sheet, then try query again and it's working.
I think my sheets name before conflict with excels default names, which is my sheets name on name manager have single quote