I'm trying to write record set contents to excel sheet. My code is not working when trying to move record set contents to Movefirst. My vba code
Set cnn = CurrentProject.Connection
Set rst = New ADODB.Recordset
strSQL = "SELECT * FROM " & qrytable & ""
rst.Open strSQL, cnn, adOpenKeyset, adLockOptimistic, adCmdTableDirect
Set wsSheet1 = wb.Sheets(conSHT_NAME)
wsSheet1.Cells.ClearContents
wsSheet1.Select
For i = 1 To rst.Fields.Count
wsSheet1.Cells(1, i) = rst.Fields(i - 1).Name
Next i
If rst.EOF Then
MsgBox "inside rst"
rst.MoveFirst
wsSheet1.Range("a2").CopyFromRecordset rst
End If
wsSheet1.Columns("A:Q").EntireColumn.AutoFit
rst.Close
The condition If rst.EOF is becomes true and when i'm trying to move record set to rst.Movefirst the debugging control is moving out of the method and moving to the method from where i'm calling this method and not writing contents to excel.
Test for a null recordset with the following:
If (rst.BOF And rst.EOF) Then
rst.Close: set rst = Nothing
Else
rst.MoveFirst
rst.CopyFromRecordset rst
End If
Related
I have DAO recordset that is generated with pass-through query to postgresql stored function. I use it to fill out combobox in my form. What I need is additional item in combobox with "AllItems" description. But the recordset is read-only (that's normal in this case). So I cannot just add new row to it. Can I do any kind of in memory recordset clone, copy or anything like that to make addition possible? I don't want to update recordsource. And I don't want to hardcode this option in to the pgsql function as well.
Public Sub fillCboAssortmentType()
Dim rs As DAO.Recordset
If (lngViewContext = acMyItems) Then
Set rs = getAssortmentTypesByDAO(TempVars!loggedUser)
Else (lngViewContext = acAllItems) Then
Set rs = getAssortmentTypesByDAO
End If
' It wont work, because the rs is RO
With rs
.AddNew
!type_id = 0
!type_name = "***AllItems***"
End With
' It wont work neither, because cboTypeFilter rowsource is Table/Query
Set Me.cboTypeFilter.Recordset = rs
Me.cboTypeFilter.AddItem "0;***AllItems***"
End Sub
Any suggestions?
TY All.
I think you are asking for a "In Memory" Recordset. Let's assume you have a table which looks like this
Then the following code will read the values from the table and copy it to a in memory recordset and add a new value but only in memory
Option Compare Database
Option Explicit
Sub inMemory()
Dim rs As ADODB.Recordset
Set rs = New ADODB.Recordset
With rs.Fields
.Append "val", adVarChar, 64
End With
Dim sourceRs As DAO.Recordset
Dim db As DAO.Database
Set db = CurrentDb
Set sourceRs = db.OpenRecordset("SELECT * FROM tbl")
Dim i As Long
rs.Open
Do Until sourceRs.EOF
rs.AddNew
rs.Fields(0).Value = sourceRs.Fields(0).Value
rs.Update
sourceRs.MoveNext
Loop
rs.AddNew
rs.Fields(0).Value = "Cancel"
rs.Update
' let's print the list just for testing
rs.MoveFirst
Do Until rs.EOF
Debug.Print rs.Fields(0).Value
rs.MoveNext
Loop
End Sub
I want to have a button on the Excel spreadsheet and have the data copied to the Access table.
The range is an auto-populated field from another sheet in the same workbook.
I tried few codes to make this happen, but I either get an error 1004: application-defined or object-defined error, or no error but data not being copied in Access DB.
My code is copied below.
Sub Export_Data()
Dim cnn As ADODB.Connection
Dim rst As ADODB.Recordset
Dim dbPath
Dim x As Long, i As Long
dbPath = "H:\RFD\RequestForData.accdb"
Set cnn = New ADODB.Connection
cnn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & dbPath
Set rst = New ADODB.Recordset 'assign memory to the recordset
rst.Open Source:="tblRequests", ActiveConnection:=cnn, _
CursorType:=adOpenDynamic, LockType:=adLockOptimistic, _
Options:=adCmdTable
rst.AddNew
For i = 1 To 13
rst(Cells(1, i).Value) = Cells(x, i).Value
Next i
rst.Update
rst.Close
cnn.Close
Set rst = Nothing
Set cnn = Nothing
MsgBox " The data has been successfully sent to the access database"
Set rst = Nothing
Set cnn = Nothing
End Sub
Looking at your Subroutine I see two things that can make it not to work:
rst(Cells(1, i).Value) = Cells(x, i).Value <- Where is 'x' initialized?
There is only one loop that moves over the fields but I think it should be another loop for the rows in the Excel.
With this two changes, the loop when the records are save could become something like this:
For x = 1 TO lastRow ' Last row has to be calculated somehow
rst.AddNew
For i = 1 To 13
rst(Cells(1, i).Value) = Cells(x, i).Value
Next i
rst.Update
Next x
Hope it helps.
I am new to VBA and am working on a project which will display all current users who have a particular file open (MS Access). I am trying to populate a listbox with the computer name info but am getting an error when I try to run the button command.rs.Fields(0) is the only field I need as it is the computer name. I just need a list of all computer names connected.
Sub ShowUserRosterMultipleUsers()
Dim cn As New ADODB.Connection
Dim rs As New ADODB.Recordset
Set cn = CurrentProject.Connection
Set rs = cn.OpenSchema(adSchemaProviderSpecific, _
, "{947bb102-5d43-11d1-bdbf-00c04fb92675}"
'While Not rs.EOF
'Debug.Print rs.Fields(0), rs.Fields(1), _
'rs.Fields(2), rs.Fields(3)
'rs.MoveNext
'Wend
Do While Not rs.EOF
With List73
.AddItem rs.Fields(0)
End With
Next
End Sub
Sub ShowUserRosterMultipleUsers()
Dim cn As New ADODB.Connection
Dim rs As New ADODB.Recordset
Set cn = CurrentProject.Connection
Set rs = cn.OpenSchema(adSchemaProviderSpecific, _
, "{947bb102-5d43-11d1-bdbf-00c04fb92675}"
'While Not rs.EOF
'Debug.Print rs.Fields(0), rs.Fields(1), _
'rs.Fields(2), rs.Fields(3)
'rs.MoveNext
'Wend
Do While Not rs.EOF
With List73
.AddItem rs.Fields(0)
End With
Loop
End Sub
I'm trying to write a piece of code that will run through a table and replace every field that has a certain value with another value.
Private Sub Form_Load()
Dim db As DAO.Database
Dim rst As DAO.Recordset
Dim strSQL As String
Set db = CurrentDb()
strSQL = "SELECT Profile3 FROM Bank WHERE 'AB'"
Set rst = db.OpenRecordset(strSQL, dbOpenDynaset)
Do Until rst.EOF
With rst
If .RecordCount > 0 Then
.MoveFirst
.Edit
!Profile3 = "AA"
.Update
.MoveNext
End If
End With
Loop
End Sub
That's what I'm currently using, however, when it runs it crashes horribly. I know the base code works because when I pull out the loop it works, but only on the first entry.
Like most of the issues I seem to have with VBA, it's probably an absurdly simple fix that I am overlooking.
Thank you for your help.
You are constantly moving first. You need to get on at some stage. Just get rid of MoveFirst.
Do Until rst.EOF
With rst
.Edit
!Profile3 = "AA"
.Update
.MoveNext
End With
Loop
In addition, I guess you mean WHERE somefield:
strSQL = "SELECT Profile3 FROM Bank WHERE somefield='AB'"
However, in this case, I suspect what you need is:
strSQL = "UPDATE Bank SET Profile3 ='AA' WHERE Profile3 ='AB'"
CurrentDB.Execute strSQL, dbFailOnError
I am using DoCmd.TransferSpreadsheet to populate a table. This command is being called using a button on a form. After the transfer is complete I want to tell the user how many records were added. To try and accomplis this I use db.OpenRecordset("select * from tblImport")
then MsgBox(rs.RecordCount)
The problem is that the record count is being called before the transfer is complete. Is there anyway to call this synchronously?
Here is the complete code
Private Sub cmdVIT_Click()
On Error Resume Next
Dim strPath As String
Dim filePicker As FileDialog
Dim db As DAO.Database
Dim rs As DAO.Recordset
Set db = CurrentDb
Set filePicker = Application.FileDialog(msoFileDialogFilePicker)
With filePicker
.AllowMultiSelect = False
.ButtonName = "Select"
.InitialView = msoFileDialogViewList
.Title = "Select File"
With .Filters
.Clear
.Add "All Files", "*.*"
End With
.FilterIndex = 1
.Show
End With
strPath = filePicker.SelectedItems(1)
Debug.Print strPath
DoCmd.TransferSpreadsheet TransferType:=acImport, SpreadsheetType:=acSpreadsheetTypeExcel12, TableName:="tblImport", FileName:=strPath, HasFieldNames:=True
Set rs = db.OpenRecordset("select * from tblImport")
MsgBox rs.RecordCount & " records"
End Sub
You need an extra line:
Set rs = db.OpenRecordset("select * from tblImport")
'Populate recordset
rs.MoveLast
MsgBox rs.RecordCount & " records"
You want to display the number of rows contained in tblImport. I don't think you need a recordset to give you that information. Try one of these ...
MsgBox CurrentDb.TableDefs("tblImport").RecordCount & " records"
MsgBox DCount("*", "tblImport") & " records"
However if you need or just want to do it with a recordset, use a faster approach for OpenRecordset.
Set rs = db.OpenRecordset("tblImport", dbOpenTable, dbReadOnly)
rs.MoveLast
MsgBox rs.RecordCount & " records"