I have a database from which I create many Excel files via DAO recordset+CopyFromRecordset. There is an odd error where the CopyFromRecordset command sometimes produces an error, but if I just simply press Continue in the debugger it goes on without problem. This reminded me I needed to set up the parameters for OpenRecordset - but how?
What I do is query different parts of a table and put the queried part to an Excel file. Read only recordset.
So, RecordsetTypeEnum is dbOpenSnapshot, that is clear.
RecordsetOptionEnum? I use dbFailOnError when I want to read/write, but makes no sense in this case. Does dbRunAsync make sense, since I'm querying the same table multiple times in relatively quick succession? Any other parameter that is useful?
LockTypeEnum? Is there a difference when using a snapshot?
I couldn't find any good comprehensive description of these settings.
My code below, not that is too relevant:
Set MyDb = CurrentDb
Set rsGLAP = MyDb.OpenRecordset("SELECT DISTINCT GL_Account FROM APCommentedData WHERE CoCode = """ & CoCd & """;", dbOpenSnapshot)
If Not (rsGLAP.BOF And rsGLAP.EOF) Then
rsGLAP.MoveFirst
Do Until rsGLAP.EOF
Set wsAccount = wb.worksheets.Add
wsAccount.Name = rsGLAP.Fields(0).Value
Set rs1 = MyDb.OpenRecordset("SELECT * FROM APCommentedData WHERE CoCode = """ & CoCd & """ AND GL_Account = """ & rsGLAP.Fields(0).Value & """;",dbOpenSnapshot)
'headers
For i = 0 To rs1.Fields.Count - 1
wsAccount.cells(33, i + 1).Value = rs1.Fields(i).Name
Next
'data
wsAccount.cells(34, 1).copyfromrecordset rs1
rs1.Close
Set rs1 = Nothing
rsGLAP.MoveNext
Loop
Related
I'm attempting to create a macro that based on a user input (on an excel sheet) will pull data from a query I made in Access. In order for it to pull only the applicable lines (rows) of data it needs to edit the WHERE statement accordingly. I have adapted the following code from a previous question but I am running into issues when I try to replace the SQL.
Private Sub CommandButton4_Click()
Const DbLoc As String = "MYfilepath"
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim wb1 As Workbook, ws1 As Worksheet, ws2 As Worksheet, SQL As String, recCount As Long
Set wb1 = Workbooks("mytool.xlsm")
Set ws1 = wb1.Sheets("Inputs")
Set ws2 = wb1.Sheets("raw")
Set db = OpenDatabase(DbLoc)
Set userinput = ws1.Range("D6")
SQL = "SELECT Dock_Rec_Problems.Merch_Name, Dock_Rec_Problems.Vendor_Error_Code, Dock_Rec_Problems.DC, Dock_Rec_Problems.Vendor_ID_IP, Dock_Rec_Problems.Vendor_Name, Dock_Rec_Problems.PO_Number, Dock_Rec_Problems.SKU_No, Dock_Rec_Problems.Item_Description, Dock_Rec_Problems.Casepack, Dock_Rec_Problems.Retail, Dock_Rec_Problems.Num_Of_Cases, Dock_Rec_Problems.Dock_Rec_Problems_DGID"
SQL = SQL & "FROM Dock_Rec_Problems;"
SQL = SQL & "WHERE [Dock_Rec_Problems_DGID] =" & userinput
Set rs = db.OpenRecordset(SQL, dbOpenSnapshot)
If rs.RecordCount = 0 Then
MsgBox "Not found in database", vbInformation + vbOKOnly, "No Data"
GoTo SubExit
End If
ws2.Range("A1").CopyFromRecordset rs
SubExit:
On Error Resume Next
Application.Cursor = xlDefault
rs.Close
Set rs = Nothing
Exit Sub
End Sub
Let me know if there is anything I can clear up...thanks!
Original Query SQL
SELECT Dock_Rec_Problems.Merch_Name, Dock_Rec_Problems.Vendor_Error_Code,
Dock_Rec_Problems.DC, Dock_Rec_Problems.Vendor_ID_IP,
Dock_Rec_Problems.Vendor_Name, Dock_Rec_Problems.PO_Number,
Dock_Rec_Problems.SKU_No, Dock_Rec_Problems.Item_Description,
Dock_Rec_Problems.Casepack, Dock_Rec_Problems.Retail,
Dock_Rec_Problems.Num_Of_Cases, Dock_Rec_Problems.Dock_Rec_Problems_DGID
FROM Dock_Rec_Problems;
Single input SQL
SELECT Dock_Rec_Problems.Merch_Name, Dock_Rec_Problems.Vendor_Error_Code, Dock_Rec_Problems.DC, Dock_Rec_Problems.Vendor_ID_IP, Dock_Rec_Problems.Vendor_Name, Dock_Rec_Problems.PO_Number, Dock_Rec_Problems.SKU_No, Dock_Rec_Problems.Item_Description, Dock_Rec_Problems.Casepack, Dock_Rec_Problems.Retail, Dock_Rec_Problems.Num_Of_Cases, Dock_Rec_Problems.Dock_Rec_Problems_DGID
FROM Dock_Rec_Problems
WHERE (((Dock_Rec_Problems.Dock_Rec_Problems_DGID)="D040323000"));
Double input SQL
SELECT Dock_Rec_Problems.Merch_Name, Dock_Rec_Problems.Vendor_Error_Code, Dock_Rec_Problems.DC, Dock_Rec_Problems.Vendor_ID_IP, Dock_Rec_Problems.Vendor_Name, Dock_Rec_Problems.PO_Number, Dock_Rec_Problems.SKU_No, Dock_Rec_Problems.Item_Description, Dock_Rec_Problems.Casepack, Dock_Rec_Problems.Retail, Dock_Rec_Problems.Num_Of_Cases, Dock_Rec_Problems.Dock_Rec_Problems_DGID
FROM Dock_Rec_Problems
WHERE (((Dock_Rec_Problems.Dock_Rec_Problems_DGID)="D040323000")) OR (((Dock_Rec_Problems.Dock_Rec_Problems_DGID)="D040323012"));
Because the size of your user input is open-ended, consider using a temp table saved in MS Access with exact structure as your query (can be built with: SELECT * INTO temp_table FROM myquery). Then, with each call of the Excel macro:
Clean the temp table out with DELETE.
Iterate through the user input Excel range of cells to append needed rows to table with INSERT INTO...SELECT.
Create recordset from temp table.
And once again, here is a prime use case for SQL parameterization especially since the query receives user input. A clever, malicious user can potentially clean out your database! But at the very least, code is arguably more maintainable. Because you are using DAO, consider QueryDefs to bind parameter value to a prepared, saved query and then bind into a recordset.
SQL (save as an MS Access stored action query)
PARAMETERS [userparam] TEXT(255);
INSERT INTO Excel_Table (Merch_Name, Vendor_Error_Code, DC, Vendor_ID_IP,
Vendor_Name, PO_Number, SKU_No, Item_Description,
Casepack, Retail, Num_Of_Cases, Dock_Rec_Problems_DGID)
SELECT d.Merch_Name, d.Vendor_Error_Code, d.DC, d.Vendor_ID_IP,
d.Vendor_Name, d.PO_Number, d.SKU_No, d.Item_Description,
d.Casepack, d.Retail, d.Num_Of_Cases, d.Dock_Rec_Problems_DGID
FROM Dock_Rec_Problems d
WHERE d.[Dock_Rec_Problems_DGID] = [userparam];
VBA
...
Dim qdef As DAO.QueryDef
Dim cel As Range
Set qdef = db.QueryDefs("mySavedQuery")
' CLEAN OUT TEMP EXCEL TABLE
db.Execute "DELETE FROM Excel_Table"
' ITERATIVELY APPEND TO EXCEL TABLES
For Each cel In userinput.Cells
qdef!userparam = cel.Value ' BIND PARAM
qdef.Execute dbFailOnError ' EXECUTE ACTION
Next cel
' OPEN RECORDSET TO TABLE
Set rs = db.OpenRecordset("Excel_Table", dbOpenSnapshot)
If rs.RecordCount = 0 Then
MsgBox "Recieving problem not found in database", vbInformation+vbOKOnly, "No Data"
GoTo SubExit
End If
ws2.Range("A1").CopyFromRecordset rs
.......
There are a few problems with the code you've displayed. For instance, the strNewFields variable is attempted to be used, before you've set it to anything, here:
strNewSQL = strNewSQL & Replace(WHERE_FIELDS, "<INSERT FIELDS>", strNewFields)
At this point strNewFields is totally blank, but you're trying to do a replace.
I would suggest:
Change you WHERE_FIELDS Const from
Const WHERE_FIELDS As String = "WHERE " _
& "(((Dock_Rec_Problems.Dock_Rec_Problems_DGID) = <INSERT FIELDS>)); "
to
Const WHERE_FIELDS As String = "WHERE " _
& " [Dock_Rec_Problems].[Dock_Rec_Problems_DGID] IN (<INSERT FIELDS>); "
I find this easier to read then all the nested brackets, it removes the equals sign in preference of the IN() statement.
Now you want to populate the strNewFields variable with whatever inputs they gave you. Probably using a Do While Loop to iterate through the INPUTS. Each input is added to the strNewFields variable something like this.
Dim rs as Recordset
Set RS = currentdb.mydataset ' You need to modify this line
rs.Open
strNewFields = strNewFields & "'" & rs("InputFieldName") & "'"
rs.MoveNext
Do While rs.EOF = False
strNewFields = strNewFields & ",'" & rs("InputFieldName") & "'"
Loop
strNewFields = StrNewFields & ")"
Now that you have strNewFields populated you can simply run your replace()
Replace(WHERE_FIELDS, "<INSERT FIELDS>", strNewFields)
You need to look at the order in which you are setting variables though, as pointed out above, you've got some order of event issues.
Michael
I am using Access 2016 VBA. All code works fine, otherwise.
Public Function PopUp()
Dim strSQL As String
Dim rs As DAO.Recordset
Dim db As DAO.Database
strSQL = "SELECT PopUpReminders.*, PopUpReminders.ReminderCompletion, PopUpReminders.ReminderStartDate, PopUpReminders.Employee FROM PopUpReminders WHERE (((PopUpReminders.ReminderCompletion)=False) AND ((PopUpReminders.ReminderStartDate)<=Now() AND ((PopUpReminders.Employee)='" & Forms![Login]![txtUserName] & "'));"
Set db = CurrentDb
Set rs = db.OpenRecordset(strSQL)
If rs.RecordCount = 0 Then
'Do Nothing
Else
If rs.RecordCount > 0 Then
Do
DoCmd.OpenForm "SFPopUpReminder"
Loop Until rs!ViewedRecord = True
End If
End If
rs.Close
Set rs = Nothing
End Function
The error that appears is (copied exactly)
MS VB Run-time error 3075: Syntax error in query expression
'(((PopUpReminders.ReminderCompletion)=False) And
((PopUpReminders.ReminderStartDate)<=Now() And ((PopUpReminders.Employee)='rerdeljac'));'.
Please note, "rerdeljac" is the logintext entered into the textbox on Forms![Login]![txtUserName] and which was matched to PopUpReminders.Employee; please note also that the error message does not include the remainder of the SQL code.
(PopUpReminders.Employee) is a field on a table filled only with text, and Forms![Login]![txtUserName] is a textbox on a form intended to be filled only with text characters.
The error occurs on the Set rs = db.OpenRecordset(strSQL) line.
Your statement needs one more ) right after Now() if I am counting right. Your SQL statement is overly complicated (probably because you copied it from a query you made using the GUI). This is sufficient:
"SELECT * FROM PopUpReminders WHERE ReminderCompletion=False AND ReminderStartDate<=Now() AND Employee='" & Forms![Login]![txtUserName] & "'"
This will fail if one of your users decides to type a ' (single quote) in txtUserName. You should at least change it to Replace(Forms![Login]![txtUserName],"'","''")
Also RecordCount is not reliable. You should use rs.EOF=False OR rs.BOF=False to check if any records were returned and iterate through them with rs.MoveFirst and rs.MoveNext.
Actually, it was a combination of Fionnuala's removal of column names and SunKnight0's addition of the parentheses after the Now() that cured the issue. I can't put the answer to both, and SunKnight went way above and beyond so he gets the mark. Here is the corrected code, for those who might need it in the future:
strSQL = "SELECT PopUpReminders.* FROM PopUpReminders WHERE (((PopUpReminders.ReminderCompletion)=False) AND ((PopUpReminders.ReminderStartDate)<=Now()) AND ((PopUpReminders.Employee)='" & Forms![Login]![txtUserName] & "'));"
I want to import some data from a .csv file into a MS Access database via VBScript.
Sub CSVImport
connStr = "Provider=Microsoft.ACE.OLEDB.12.0; Data Source=P:\somedatabase.accdb"
'Define object type
Set objConn = CreateObject("ADODB.Connection")
Set objRecordSet = CreateObject("ADODB.Recordset")
'Open Connection
objConn.open connStr
objRecordSet.Open "SELECT * FROM SomeTable", _
objConn, adOpenStatic, adLockOptimistic
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.OpenTextFile("P:\someFile.csv")
Do Until objFile.AtEndOfStream
strVKBL_Stamm = objFile.ReadLine
arrVKBL_Stamm = Split(strVKBL_Stamm, ";")
objRecordSet.AddNew
objRecordSet("FirstName") = arrVKBL_Stamm(0)
objRecordSet("LastName") = arrVKBL_Stamm(1)
objRecordSet("Date") = arrVKBL_Stamm(...)
objRecordSet("Type") = arrVKBL_Stamm(11)
Loop
Set objRecordSet = Nothing
Set objFSO = Nothing
Set objFile = Nothing
Set objConn = Nothing
End Sub
This script gets all the data out of my CSV file but it does miss the last line. When I hit return twice (once doesn't suffice) at the end of the .csv all of my data gets imported.
My backup plan is to change the AtEndOfStream bit to something like
If arrVKBL_Stamm(0) = 0 Then
Exit Do
and add a zero to the file. Problem is, the .csv is a report, exported from SAP (which is - afaik - unable to export to MS Access itself), so that part would need another script or has to be done by hand.
Does anyone have a clue or give me a hint how to solve this?
I tried this code:
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.OpenTextFile("D:\myfile.csv", 1)
Do Until objFile.AtEndOfStream
S = objFile.ReadLine
Debug.Print S
Loop
objFile.Close
in VBA and it printed all lines of my CSV file, even if the last line doesn't end with a CrLf.
I'm pretty sure the reason is: your objRecordSet.AddNew is missing an objRecordSet.Update.
Apparently, if you call .AddNew after the previous .AddNew, the previous record is saved nevertheless.
But objRecordSet.AddNew followed by Set objRecordSet = Nothing doesn't save the last record.
Solution: add objRecordSet.Update as last command in the loop.
SAP uses a standard database engine in the back end. You can set up linked tables that pull directly from SAP in to Access. No export\import. It's a live table.
SEE HERE:
How do I configure my Microsoft Access database to pull source data directly from SAP BW?
https://archive.sap.com/discussions/thread/1382889
I'm trying to move data from a table1 in database 1 to table2 in database 2. Table 1 has the same fields as table 2. Table 1 has data and Table 2 don't have.
rsDenuncia is the recordset of table 1 from database 1
regNuevoDenuncia is the recorset of table 2 from database 2
I instantiate a child recordset of rsDenuncia that is named rsODenuncia and it works because
I can retrieve data using msgboxes.
Set rsODenuncia = rsDenuncia.Fields("pdfAdjunto").Value
MsgBox "Nombre el archivo: " & rsODenuncia("FileName").Value
MsgBox "Tipo de archivo: " & rsODenuncia.Fields("FileType").Value
MsgBox "Data del archivo: " & rsODenuncia.Fields("FileData").Value
But when I try to instantiate the recordset of table 2 (that is an empty table but with same fields as table 1) is gives a error. "No current record"
Set regONuevoDenuncia = regNuevoDenuncia.Fields("pdfAdjunto").Value
Is there a way to instantiate regONuevoDenuncia without using the Value method so I can add new data?
Thanks in advance.
You need to create the new parent record with regNuevoDenuncia.AddNew before you can open the child recordset for its attachments. The following code is a minimal example:
Option Compare Database
Option Explicit
Sub CopyRecordsWithAttachments()
Dim cdb As DAO.Database
Dim rsDenuncia As DAO.Recordset2, rsODenuncia As DAO.Recordset2
Dim regNuevoDenuncia As DAO.Recordset2, regONuevoDenuncia As DAO.Recordset2
Set cdb = CurrentDb
cdb.Execute "DELETE FROM NuevoDenuncia", dbFailOnError ' clear previous test data, if any
Set rsDenuncia = cdb.OpenRecordset("Denuncia", dbOpenSnapshot)
Set regNuevoDenuncia = cdb.OpenRecordset("NuevoDenuncia", dbOpenDynaset)
Do Until rsDenuncia.EOF
regNuevoDenuncia.AddNew
regNuevoDenuncia!ID = rsDenuncia!ID
Set rsODenuncia = rsDenuncia.Fields("pdfAdjunto").Value
Set regONuevoDenuncia = regNuevoDenuncia.Fields("pdfAdjunto").Value
Do Until rsODenuncia.EOF
regONuevoDenuncia.AddNew
regONuevoDenuncia!FileName = rsODenuncia!FileName
regONuevoDenuncia!FileData = rsODenuncia!FileData
regONuevoDenuncia.Update
rsODenuncia.MoveNext
Loop
regONuevoDenuncia.Close
Set regONuevoDenuncia = Nothing
rsODenuncia.Close
Set rsODenuncia = Nothing
regNuevoDenuncia.Update
rsDenuncia.MoveNext
Loop
regNuevoDenuncia.Close
Set regNuevoDenuncia = Nothing
rsDenuncia.Close
Set rsDenuncia = Nothing
Set cdb = Nothing
Debug.Print "Terminado."
End Sub
You can't reference that field, in the manner you are, in the recordset for DB2 until the recordset is populated. Once you add records to DB2, then the error will go away.
Without seeing all your code, I suggest you do something like:
If not regNuevoDenuncia.eof then
Set regONuevoDenuncia = regNuevoDenuncia.Fields("pdfAdjunto").Value
I've written some VBA:
For x = LBound(resProdID) To UBound(resProdID)
CurrentDb.QueryDefs("qry_findID_vba").SQL = "" & _
"SELECT tbl_products.ProdID " & _
"FROM tbl_products " & _
"WHERE (tbl_products.Size = " & resSize(x) & " " & _
"AND tbl_products.SupplID = '" & Forms.frm_suppliers.SupplID & "')"
Dim dbs As DAO.Database
Dim rst As DAO.Recordset
Set dbs = CurrentDb()
Set rst = dbs.OpenRecordset("qry_findID_vba")
MsgBox rst.RecordCount
If rst.RecordCount <> 0 Then
rst.MoveLast
rst.MoveFirst
newProdID(x) = rst.Fields(0).Value
MsgBox "This never fires"
End If
rst.Close
Set rst = Nothing
dbs.Close
Set dbs = Nothing
Next x
What happens when I run it, is that a box pops up saying 0. I click Ok, and it repeats one more time. This is because I have two items in my resProdID-array.
However, if I open the query "qry_findID_vba" normally, it shows one row, like I expected.
Why doesn't VBA return this row? Have I done anything wrong?
Does this code messagebox the correct count? Can you use it instead?
(Note, I haven't actually run it, so watch out for slight syntax errors.)
For x = LBound(resProdID) To UBound(resProdID)
Dim sql as String
Dim rst As DAO.Recordset
sql = "Select tbl_products.ProdID FROM tbl_products " & _
"WHERE (tbl_products.Size = " & resSize(x) & " " & _
"AND tbl_products.SupplID = '" & Forms.frm_suppliers.SupplID & "')"
Set rst = dbs.OpenRecordset(sql)
if not rst.eof then
MsgBox rst.fields("ProdID")
else
Msgbox "None found!"
end if
rst.Close
Set rst = Nothing
Next x
Also, try copying everything to a new form, and compacting and repairing the database ...
First off, you really should use QueryDef parameters. They provide a number of benefits:
A safety net against malformed input and SQL injection.
You don't need to redefine the query SQL text every time a parameter value changes.
They make your VBA independent of the query text. This is a simple query, but more complex ones benefit if you don't have to change your VBA code just to change the SQL.
They provide type safety - you can use typed variables in VBA and be sure that the query cannot fail with data type errors.
They can be re-used - parameterized queries can be bound to forms, or executed directly, for example.
Last but not least, it looks much nicer and clearer when used in VBA.
Your situation is exactly what parameterized QueryDefs are for.
Change the query text of qry_findID_vba in Access to:
PARAMETERS [ProductSize] Text (255), [SupplID] Number;
SELECT ProdID
FROM tbl_products
WHERE [tbl_products].[Size] = [ProductSize] AND [tbl_products].[SupplID] = [SupplID];
Replace the parameter data types according to your actual data types in the table.
Next, when you're in a loop, don't re-define fixed variables again and again. dbs and rst don't need to be defined inside the loop at all.
Last point, the RecordCount property does not work the way you think. Quote from the docs, emphasis mine:
Use the RecordCount property to find out how many records in a
Recordset or TableDef object have been accessed. The RecordCount
property doesn't indicate how many records are contained in a
dynaset–, snapshot–, or forward–only–type Recordset object until all
records have been accessed.
[...]
To force the last record to be accessed, use the MoveLast method on the Recordset object.
Instead of calling MoveLast, you can also check the .EOF property. If it is false, at least one record is available.
For one-off query results like this one, I would recommend using the snapshot type Recordset. You can define which type you want to use when you call OpenRecordset on the QueryDef.
Now:
Dim qry_findID_vba As DAO.QueryDef
Set qry_findID_vba = CurrentDb().QueryDefs("qry_findID_vba")
qry_findID_vba.Parameters("SupplID") = Forms.frm_suppliers.SupplID
For x = LBound(resProdID) To UBound(resProdID)
qry_findID_vba.Parameters("ProductSize") = resSize(x)
With qry_findID_vba.OpenRecordset(dbOpenSnapshot)
If Not .EOF Then
newProdID(x) = .Fields("ProdID").Value
End If
End With
Next x
Note that I use With to save maintaining a helper rst variable.