I'm new to Access and thank you for reading this first.
I'm exporting a query in Access to a pipe delimited CSV file. The query is from a table which is ODBCed from SQL.
I've been getting for the line dbs.Recordset : Method or data member not found error.
Huge thanks for any suggestion to fix this.
Option Compare Database
Option Explicit
Sub Command12_Click()
Dim dbs As DAO.database
Dim rst As DAO.Recordset
Dim intFile As Integer
Dim strFilePath As String
Dim intCount As Integer
Dim strHold
strFilePath = "C:\temp\TEST.csv"
Set dbs = CurrentDb
Set rst = db.OpenRecordset("T_Export_CSV", dbOpenForwardOnly)
intFile = FreeFile
Open strFilePath For Output As #intFile
Do Until rst.EOF
For intCount = 0 To rst.Fields.Count - 1
strHold = strHold & rst(intCount).Value & "|"
Next
If Right(strHold, 1) = "|" Then
strHold = Left(strHold, Len(strHold) - 1)
End If
Print #intFile, strHold
rst.MoveNext
strHold = vbNullString
Loop
Close intFile
rst.Close
Set rst = Nothing
MsgBox ("Export Completed Successfully")
End Sub
Thank you so so much for your time and please leave any comment below for any clarification if needed. I will try my best to be responsive!
Office 15.0 object library is the one you need to include in the references for O365 objects or Office 2013 Access VBA
Related
I have some vba code that 'attempts' to loop through an array of DAO recordsets. When running the loop, I get a runtime error 'Oject required' at rst.MoveFirst. It seems that rst is not properly initialized but I'm not sure how to fix it. Maybe looping through an array of recordsets isnt even possible in this way I have never tried it before. The code runs from a custom class module. There is a bunch more code in the module but most of the important stuff I post below. A couple things I tried:
Set rst to a new recordset instance manually:
Set rst = New DAO.Recordset
Declaring the array outside the loop:
Set recordsets = Array(rstRechenwerte, rstZwischenwerte, rstZutaten)
' Loop through each recordset and insert data into Excel file
For Each rst In recordsets
Setting rst to an open recordset right before rst.MoveFirst:
For Each rst In Array(rstRechenwerte, rstZwischenwerte, rstZutaten)
Set rst = rst.OpenRecordset()
rst.MoveFirst
The three recordsets in the array are properly initialized, set and are not Nothing. I had previously written the code for each of the three recordsets seperately and it works that way. I am aware that I need to change the variable name XLColumn, but thats not really an issue atm. Its probably something bassic but I couldn't figure it out for a while now so I thought I'd just ask.
I am using the following libraries for which references are properly set:
Visual Basic for Applications
Microsoft Access 16.0 Object Library
OLE Automation
Microsoft Office 16.0 Access database engine Object
Library
Microsoft Excel 16.0 Object Library
Microsoft Office 16.0 Object Library
My version of Access:
Microsoft® Access® für Microsoft 365 MSO (Version 2301 Build 16.0.16026.20002) 32 Bit
The code:
Option Compare Database
Option Explicit
Dim xlApp As Object
Dim xlWB As Object
Dim xlSheet As Object
Dim rsRes As DAO.Recordset 'rs of temp table (Output)
Dim rsZwi As DAO.Recordset 'rs of temp table (Zwischenwerte)
Dim rsRec As DAO.Recordset 'rs clone of subform Rechenwerte
Dim Recordset As Recordset
Dim rstRechenwerte As DAO.Recordset 'rs of tblRechenwerte
Dim rstZwischenwerte As DAO.Recordset 'rs of tblZwischenwerte
Dim rstZutaten As DAO.Recordset 'rs of tblZutaten
Dim RezeptID As Integer 'Current form active RezeptID
Dim RechengruppeID As Integer 'Current Form active RechengruppeID
Dim xlColumn As String 'Excel Column of Zutaten
Dim xlLastRow As Long 'Excel last row number after insertion
Dim xlColumn2 As String 'Excel Column one to the right of Zutaten
Dim k As Integer
Dim Export As Boolean 'Export the Excel File
Dim ExclExportPath As String 'Export location as string
Sub Calculate()
'***************************************************************************
'Purpose: Calculate a recipe based on Rechenwerte,
'save them temporarily and display them on a form.
'Inputs: None
'***************************************************************************
'***********************************************************************
' Preparations
'***********************************************************************
'Disable user input
Call mdlMiscFunctions.DisableKeyboardMouse(True)
'Clear temporary data tables for Results and Zwischenwerte
If Not rsRes.EOF Then Call ClearTableOnClose("tblTempResults")
If Not rsZwi.EOF Then Call ClearTableOnClose("tblTempZwischenwerte")
'Prevent prompt to save changes to excel
xlApp.DisplayAlerts = False
xlApp.Visible = False
'***********************************************************************
' Insert Data into Excel File
'***********************************************************************
Dim rst As DAO.Recordset
Dim xlCell As String
Dim xlFormula As String
Dim xlColumn As String
' Loop through each recordset and insert data into Excel file
For Each rst In Array(rstRechenwerte, rstZwischenwerte, rstZutaten)
rst.MoveFirst
If Not rst.EOF Then
Do Until rst.EOF
xlCell = rst!xlCell
xlSheet.Range(xlCell).Value = rst.Fields(1)
If rst.Fields.Count > 2 Then
xlFormula = rst!xlFormula
xlSheet.Range(xlCell).Offset(0, 1).Formula = xlFormula
xlSheet.Range(xlCell).Offset(0, 1).Value = xlSheet.Range(xlCell).Offset(0, 1).Value
Else
xlSheet.Range(xlCell).Offset(0, 1).Value = rst.Fields(2)
End If
rst.MoveNext
Loop
Else
Select Case rst.Name
Case "rstRechenwerte"
MsgBox "Error: Keine Rechenwerte vorhanden!", vbCritical
Case "rstZwischenwerte"
MsgBox "Error: Keine Zwischenwerte vorhanden!", vbCritical
Case "rstZutaten"
MsgBox "Error: Keine Zutaten vorhanden!", vbCritical
End Select
End If
Next rst
Class initialization is the following:
Private Sub Class_Initialize()
'***************************************************************************
'Purpose: Sub for initializing class variables
'Inputs: None
'***************************************************************************
'Values for variables 1 (Neccesary for recordsets)
RezeptID = Forms.frmCalcBatch.RezeptID 'RezeptID on current form
RechengruppeID = Forms.frmCalcBatch.RechengruppeID 'Rechengruppe on Current Form
'Initialize Objects
Set xlApp = CreateObject("Excel.Application")
Set xlWB = xlApp.Workbooks.Add
Set xlSheet = xlWB.Sheets("Tabelle1") 'Set xlSheet to the first sheet in the workbook
Set rsRes = CurrentDb.OpenRecordset("tblTempResults", dbOpenDynaset)
Set rsZwi = CurrentDb.OpenRecordset("tblTempZwischenwerte", dbOpenDynaset)
Set rsRec = Forms.frmCalcBatch.frmSubRechenwerteBox.Form.Recordset.Clone 'rs clone of Rechenwerte subform
Set rstRechenwerte = CurrentDb.OpenRecordset("SELECT Rechenwert, WertBezeichnung, XLCell FROM tblRechenwerte WHERE RechengruppeID = " & RechengruppeID)
Set rstZwischenwerte = CurrentDb.OpenRecordset("SELECT ZWBezeichnung, XLFormula, XLCell FROM tblZwischenwerte WHERE RezeptID = " & RezeptID)
Set rstZutaten = CurrentDb.OpenRecordset("SELECT Zutat, XLFormula, XLCell FROM tblZutaten WHERE RezeptID = " & RezeptID)
'Values for Variables 2 (recordsets neccesary for variables)
xlColumn2 = Split(rstZutaten!xlCell, "1")(0) 'extract excel column denominator for Zutaten
xlColumn2 = Chr(Asc(xlColumn2) + 1) 'Move one column to the right using Asc (A->B etc.)
'Settings:
If Forms.frmCalcBatch.cbExport = True Then
Export = True
ExclExportPath = GetExportPath
Else
Export = False
ExclExportPath = ""
End If
End Sub
You cannot New up a DAO.Recordset, the code will not even compile.
To loop through an array of recordsets, each recordset must initialized before it is added to the array.
For example:
Dim r1 As DAO.Recordset, r2 As DAO.Recordset, r3 As DAO.Recordset
Set r1 = CurrentDb().OpenRecordset("YourTableOrQueryName")
Set r2 = CurrentDb().OpenRecordset("YourTableOrQueryName")
Set r3 = CurrentDb().OpenRecordset("YourTableOrQueryName")
Put the recordsets now in the array.
Dim arr As Variant
arr = Array(r1, r2, r3)
To loop, you need to use a For loop and either access the recordset from the array directly, or declare another recordset variable to hold the iterating recordset.
Through an iterator variable:
Dim r As DAO.Recordset, i As Integer
For i = LBound(arr) To UBound(arr)
Set r = arr(i)
If Not r.EOF Then
r.MoveFirst
Debug.Print r.RecordCount
End If
Next i
Access it directly from the array:
For i = LBound(arr) To UBound(arr)
If Not arr(i).EOF Then
arr(i).MoveFirst
Debug.Print arr(i).RecordCount
End If
Next i
Though I fail to see why you need to have 3 recordsets in memory at the same time. Personally, I would offload the work that needs to be done in the loop to a separate function and pass the recordset as parameter. The function itself would return a success/failed status, so you can take the appropriate action based on the result.
Another approach would be to store the source names in the array, and create the recordset on demand during the loop.
Hope this helps.
Here is the VBA code I have in the module:
Private Sub Workbook_Open()
Dim adoDBConn As New ADODB.connection
Dim adoDbRs As New ADODB.Recordset
Dim selectCmd As New ADODB.Command
adoDBConn.Open "Provider=SQLOLEDB;Data Source=LAPTOP-N0CT1GQ5;Initial Catalog=Interest_Analysis;User Id = ***;Password = ***;"
selectCmd.ActiveConnection = adoDBConn
selectCmd.CommandText = "County, cntyvtd, Name, Votes FROM 2020_General_Election_Returns_import_to_SQL"
Set adoDbRs = selectCmd.Execute(, , adCmdText)
Dim cellRange As Range
Set cellRange = Range(Cells(2, 2), Cells(Row.Count, 1)).EntireRow
cellRange.ClearContents
'The Worksheet tab is called "Data"
Dim ws As Worksheet
Set ws = ThisWorkbook.Worksheets("Data")
ws.Activate
If adoDbRs.EOF = False Then ws.Cells(2, 2).CopyFromRecordset adoDbRs
ws.Cells(1, 2) = "County"
ws.Cells(1, 3) = "cntyvtd"
ws.Cells(1, 4) = "Name"
ws.Cells(1, 5) = "Votes"
adoDbRs.Close
Set adoDbRs = Nothing
Set selectCmd = Nothing
adoDBConn.Close
Set adoDBConn = Nothing
End Sub
What I'm doing is using an ADODB connection to connect to SQL Server in Microsoft Excel and using VBA code to interact with the server so that the data can populate in an Excel sheet. I got much of the code template from a website, but have been running into a lot of errors and the debugger keeps pointing at different lines. Right now, it's pointing at the Set adoDbRs = selectCmd.Execute() line and saying Incorrect syntax near ',' and it would also go to the If adoDbRs.EOF = False and say Object not found. I might be missing a foundational statement or something I need to start with, so let me know what the issue is. Thank you!
To debug VBA and figure out how to pull SQL server data into an Excel spreadsheet.
This worked fine for me (against Oracle, but SQL server should work the same way)
Private Sub SOTest()
Dim adoDBConn As New adodb.Connection
Dim adoDbRs As adodb.Recordset 'no `New` here
Dim selectCmd As New adodb.Command
Dim ws As Worksheet, f As adodb.Field
Set ws = ThisWorkbook.Worksheets("Data")
adoDBConn.Open "connection string here"
selectCmd.ActiveConnection = adoDBConn
selectCmd.CommandText = "select * from myTable"
Set adoDbRs = selectCmd.Execute(, , adCmdText)
'clear the output range
ws.Range(ws.Cells(1, 2), ws.Cells(ws.Rows.Count, 15)).ClearContents
ResultsToSheet adoDbRs, ws.Cells(1, 2)
ws.Activate
adoDbRs.Close
adoDBConn.Close
End Sub
'Place a recordset contents on a worksheet (incl. headers)
' starting at `rng`
Sub ResultsToSheet(rs As adodb.Recordset, rng As Range)
Dim c As Range, f As adodb.Field
Set c = rng.Cells(1) ' top left
For Each f In rs.Fields
c.Value = f.Name 'write the field header
Set c = c.Offset(0, 1) 'next header cell
Next f
If Not rs.EOF Then
'write the data starting on the next row
rng.Cells(1).Offset(1).CopyFromRecordset rs
End If
End Sub
I'm start to do programming in Access, and I really need help!!
My objective is to create a module that is run in "tbCustoProjeto" table and rewrite the field "Valor HH" values based on Dlookup. I found some solution (by azurous) who I think will solve this, but when I run the code, is returned
"object-required-error".
Sub redefineHH()
Dim objRecordset As ADODB.Recordset
Set objRecordset = New ADODB.Recordset
Dim i As Integer
Dim value As Variant
Dim HHTotal As Double
Set HHTotal = DLookup("[CustoTotalNivel]", "tbNivelNome2", "nUsuario='" & tbCustoProjeto!NumUsuario & "'" & "AND Numeric<=" & tbCustoProjeto!DataNumero)
'initated recordset obejct
objRecordset.ActiveConnection = CurrentProject.Connection
Call objRecordset.Open("tbCustoProjeto", , , adLockBatchOptimistic)
'find the target record
While objRecordset.EOF = False
'If objRecordset.Fields.Item(13).value > 0 Then
objRecordset.Fields.Item(13).value = HHTotal
objRecordset.UpdateBatch
'exit loop
'objRecordset.MoveLast
objRecordset.MoveNext
'End If
Wend
MsgBox ("Pesquisa Finalizada")
End Sub
Print of tbCustoProjeto
Print of tbNivelNome2
Please, someone can tell me where is the error? I don't know what to do.
Cannot reference a table directly like that for dynamic parameter. DLookup should pull dynamic criteria from recordset and within loop. Don't use apostrophe delimiters for number type field parameter.
Remove unnecessary concatenation.
Sub redefineHH()
Dim objRecordset As ADODB.Recordset
Set objRecordset = New ADODB.Recordset
objRecordset.Open "tbCustoProjeto", CurrentProject.Connection, , adLockBatchOptimistic
While objRecordset.EOF = False
objRecordset.Fields.Item(13) = DLookup("[CustoTotalNivel]", "tbNivelNome2", _
"nUsuario=" & objRecordset!NumUsuario & " AND Numeric <=" & objRecordset!DataNumero)
objRecordset.UpdateBatch
objRecordset.MoveNext
Wend
MsgBox ("Pesquisa Finalizada")
End Sub
i have an ADODB recordset to load data from a view in an Excel sheet. The view is located in a MS SQL database. It runs perfectly for months, but since a few days the recordset is always empty, so i did not get any results. After a long day searching the www for any reasons i found, that it can happen because i use a x32 Excel and there is so much data in the view. So i separated the procedure in two queries. This helped a lot and the macro run perfectly again. Yesterday the same error appears again, so i began to split the procedure again. But now the recordset is still empty. I don't know any reason for this. I tested it with a selection of only ten rows of the view and this runs but if i want to get 1000 rows the recordset is empty again. Does anybody know a reason for this problem? All queries give the result i want to have in the database so they are ok.
Here is my code:
Sub doStuff()
Dim sqlStatement(9) As String
Dim lrow As Long
'... other variables
sqlStatement(1) = "Select * from db.View1 where location like 'forest'"
'... other sqlStatements
For i = 0 To UBound(sqlStatement)
Call loadData(sqlStatement, lrow)
Next i
End Sub
Sub loadData(sqlStatement As String, lastrow As Long)
Dim sqlServer As String
Dim dbName As String
sqlServer = "MSSQLSERVER"
dbName = "database"
On Error Resume Next
Dim con As Object
Set con = CreateObject("ADODB.Connection")
con.Open _
"Provider = sqloledb;" & _
"Data Source=" & sqlServer & ";" & _
"Initial Catalog=" & dbName & ";" & _
"User ID=user1;" & _
"Password=abcde;"
Dim rst As Object
Set rst = CreateObject("ADODB.Recordset")
With rst
.ActiveConnection = con
.Open sqlStatement , con, adLockReadOnly
ws.Activate
If lastrow = 1 Then
For col = 0 To .Fields.Count - 1
ws.Cells(1, col + 1).Value = .Fields(col).Name
Next
End If
ws.Activate
ws.Cells(lastrow+1,1).CopyFromRecordset rst
.Close
End With
con.Close
Set rst = Nothing
Set con = Nothing
End Sub
For those who don't know, it is fairly easy to add SQL functionality to VBA macros. The following article provides the code: http://analystcave.com/excel-using-sql-in-vba-on-excel-data/
I modified this a bit (happy to provide the code) so that it outputs nicely and put it in a Sub that I can call. This saves me from having to do multiple sorts, copy paste, etc. to find specific data from a large worksheet.
Note a problem, however, when working with the workbook from an online source e.g. Gmail:
.ConnectionString = "Data Source=" & ThisWorkbook.Path & "\" & ThisWorkbook.Name & ";"
This works fine when the file is saved to a drive, but from an online site, Excel can't connect. Any suggestions on modifying the connection string for when the file isn't saved anywhere?
For anyone who's interested, this code (based on the code from Analyst Cave) works great for using SQL in VBA. Save the following as a Sub:
Option Explicit
Sub QuerySQL(result_location As Range, query As String)
Dim ResultWS As Worksheet
Set ResultWS = ThisWorkbook.Sheets("Query Results")
ResultWS.Cells.ClearContents
If query = "" Then Exit Sub
Dim cn As Object, rs As Object
'Add to the workbook a database connection with itself
'Note other ConnectionString could be used to access a variety of media
Set cn = CreateObject("ADODB.Connection")
With cn
.Provider = "Microsoft.ACE.OLEDB.12.0"
.ConnectionString = "Data Source=" & ThisWorkbook.Path & "\" & ThisWorkbook.Name & ";" & _
"Extended Properties=""Excel 12.0 Xml;HDR=YES"";"
.Open
End With
'Build and execute the SQL query
Set rs = cn.Execute(query)
If rs.EOF = True Then Exit Sub
'Print column labels
Dim i As Long, j As Long
For i = 0 To rs.Fields.Count - 1
result_location.Offset(0, i).Value = rs.Fields(i).Name
Next i
'Print column contents
i = 0
Do
For j = 0 To rs.Fields.Count - 1
result_location.Offset(i + 1, j).Value = rs.Fields(j).Value
Next j
rs.MoveNext
i = i + 1
Loop Until rs.EOF
'Close the connections
rs.Close
cn.Close
Set rs = Nothing
Set cn = Nothing
End Sub
To use it, simply do the following:
Dim myQuery As String
myQuery = "SELECT * FROM [Sheet2$]"
Call QuerySQL(ThisWorkbook.Sheets("Sheet1").Range("A1"), myQuery)
It uses MS Access style SQL. The above will look to Sheet2 as the table and print the result starting in A1 on Sheet1.