I am trying to get a VBA function to create a folder for each program in a table. The table, TPrograms, has ProgramID as the key field. As far as I can tell, it's not actualy reading the table.
Dim rs As DAO.Recordset
Set rs = CurrentDb.OpenRecordset("SELECT * FROM TPrograms")
Do Until rs.EOF = True
If Len(Dir("Y:\Education\TEST\" & ProgramID, vbDirectory)) = 0 Then
MkDir "Y:\Education\TEST\" & ProgramID
End If
rs.MoveNext
Loop
MsgBox "Finished looping through records on record " & ProgramID
It runs, but it does nothing and ends with "through records on record" with no number at the end. Any help would be much appreciated.
You are actually not setting the variable ProgramID. Assign it a value with:
ProgramID = rs!ProgramID
Together:
Dim rs As DAO.Recordset
Set rs = CurrentDb.OpenRecordset("SELECT * FROM TPrograms")
Do Until rs.EOF
ProgramID = rs!ProgramID
If Len(Dir("Y:\Education\TEST\" & ProgramID, vbDirectory)) = 0 Then
MkDir "Y:\Education\TEST\" & ProgramID
End If
rs.MoveNext
Loop
MsgBox "Finished looping through records on record " & ProgramID
Of course you can also use the field from the recordset directly
Dim rs As DAO.Recordset
Set rs = CurrentDb.OpenRecordset("SELECT * FROM TPrograms")
Do Until rs.EOF
If Len(Dir("Y:\Education\TEST\" & rs!ProgramID, vbDirectory)) = 0 Then
MkDir "Y:\Education\TEST\" & rs!ProgramID
End If
rs.MoveNext
Loop
MsgBox "Finished looping through records on record " & rs!ProgramID
I suspect that you don't have an Option Explicit at the top of your module and didn't therefore notice that the variable ProgramID was not declared. Always use Option Explicit, this helps much in avoiding errors.
You're not assigning the VBA variable 'ProgramID' a value. You can use the .fields property of the recordset to get the value of a column for the current row.
Do Until rs.EOF = True
ProgramID = rs.Fields("ProgramID").Value
If Len(Dir("Y:\Education\TEST\" & ProgramID, vbDirectory)) = 0 Then
MkDir "Y:\Education\TEST\" & ProgramID
End If
rs.MoveNext
Loop
Related
I want your kind help to give a solution to match between two tables and return unmatched recorda with a field specify which field was unmatched.
Take a note that each table including more than 30 fields.
You can use recordsets but if your tables are long this might take a while. This is absolutely not optimized, but considering how little information you provided, I don't want to invest a whole lot of time.
I am assuming your tables are identical in structure, sorted identically, and have the same number of records. If not, feel free to adapt this however you see fit, but you should be able to get the idea of what I am doing.
It will output the field and row number of Table1 in the immediate window when a mismatch is found. You could also insert it into a temp table if you want to recover all of the field values, but again, I don't want to go that far. So this has limitations:
Public Function FindMisMatches(Table1 As String, Table2 As String)
Dim db As DAO.Database
Dim rs1 As DAO.Recordset
Dim rs2 As DAO.Recordset
Dim i As Integer
Dim Row As Integer
On Error GoTo PROC_ERR
Set db = CurrentDb
Set rs1 = db.OpenRecordset(Table1, dbOpenSnapshot, dbReadOnly)
Set rs2 = db.OpenRecordset(Table2, dbOpenSnapshot, dbReadOnly)
rs1.MoveFirst
rs2.MoveFirst
Row = 1
Do Until rs1.EOF Or rs2.EOF
'Assuming both tables have identical structure
For i = 1 To rs1.Fields.Count - 1
If rs1.Fields(i).Value <> rs2.Fields(i).Value Then
Debug.Print "Mismatch in field " & rs1.Fields(i).Name & " on row " & Row
End If
Next i
rs1.MoveNext
rs2.MoveNext
Row = Row + 1
Loop
Debug.Print "End of recordset"
Set rs1 = Nothing
Set rs2 = Nothing
Set db = Nothing
Exit Function
PROC_ERR:
MsgBox "Error: " & Err.Number & "; " & Err.Description
Set rs1 = Nothing
Set rs2 = Nothing
Set db = Nothing
End Function
I am trying to compare two recordsets in access VBA to check whether the values within the two tables are the same or whether they differ. Both recordsets have the same structure (field headings) and record IDs and I'm trying to check whether a field value for a record matches the corresponding field value in the second recordset. The record ID field name is MATNR.
I think I've managed to loop through the records and fields for the 1st recordset but I'm unsure how to loop through and compare these records with the second. Also, is there a smarter way to compare the recordsets other than If rs1.Fields(fld.Name) = rs2.Fields(fld.Name)
Any help will be greatly appreciated.
Public Sub VerifyRecords()
Dim rs As DAO.Recordset
Dim rs1 As DAO.Recordset
Dim rs2 As DAO.Recordset
Dim rs3 As DAO.Recordset
Dim fld As DAO.Field
Dim sSQL As String
Dim sSQL1 As String
Dim sSQL2 As String
Set rs = CurrentDb.OpenRecordset("R2_Tables_to_Compare1") 'This table lists the upload tables to query and their corresponding target tables
Set rs3 = CurrentDb.OpenRecordset("RecordValueComparisonResults") 'Write the results of the record vlaue comparison to here
'**************************************************************************************
'This SQL statement selects all records from the upload table
sSQL = "SELECT * "
sSQL = sSQL & " FROM " & rs(0)
Set rs1 = CurrentDb.OpenRecordset(sSQL)
'**************************************************************************************
'This SQL statement selects only those records that are applicable in the target table
sSQL1 = "SELECT " & rs(1) & ".* FROM " & rs(1) & " INNER JOIN " & rs(0) & " ON " & rs(1) & ".MATNR = " & rs(0) & ".MATNR"
Set rs2 = CurrentDb.OpenRecordset(sSQL1)
'**************************************************************************************
Do While Not rs1.EOF
For Each fld In rs1.Fields
If rs1.Fields(fld.Name) = rs2.Fields(fld.Name) Then
Debug.Print rs1.Fields("MATNR"), rs2.Fields("MATNR"), fld.Name, rs1.Fields(fld.Name), rs2.Fields(fld.Name)
End If
Next fld
rs1.MoveNext
Loop
rs.Close
rs1.Close
rs2.Close
rs3.Close
Set rs = Nothing
Set rs1 = Nothing
Set rs2 = Nothing
Set rs3 = Nothing
End Sub
Below are two options, although the QUERY OPTION is faster and better practice when working in Access and any relational DB:
QUERY OPTION: This query could be passed into a recordset and the recordset would contain only the matching values between the fields in the two tables. Then you could loop through that new recordset and print or process as necessary using a single loop.
SELECT column_name FROM table1 INNER JOIN table2 ON table1.column_name = table2.column_name;
LOOP OPTION: If you are intent on looping through both recordsets, use this code. There is probably a more efficient way to do this, especially since this method uses four nested loops which is a no-no. I would highly recommend the QUERY OPTION.
While Not rs1.EOF
While Not rs2.EOF
For Each fld1 in rs1.Fields
For Each fld2 in rs2.Fields
If rs1.Fields(fld1.Name) = rs2.Fields(fld2.Name) Then
Debug.Print rs1.Fields("MATNR"), rs2.Fields("MATNR"), fld1.Name,
rs1.Fields(fld1.Name), rs2.Fields(fld2.Name)
End If
Next fld2
Next fld1
rs2.MoveNext
Wend
rs2.MoveFirst
rs1.MoveNext
Wend
I'm trying to make a button function for deleting rows.
My code:
CurrentDb.Execute " Delete * from tblAsset where AssetID = '" & Me.tblAssetsub.Form.Recordset.Fields(0) & "' "
tblAssetsub.Form.Requery
MsgBox "Data has been Deleted"
Me.tblAssetsub.Requery
The problem is, sometimes, it gives an error when I click the button even there is a selected data. Please help me.
You could use the RecordsetClone:
Dim rs As DAO.Recordset
Dim ThisID As String
With Me!tblAssetsub.Form
Set rs = .RecordsetClone
If rs.RecordCount > 0 Then
ThisID = !AssetID.Value ' or what matches .Fields(0).
While rs.EOF = False
If rs!AssetID.Value = ThisID Then
rs.Delete
End If
rs.MoveNext
Wend
MsgBox "Data has been deleted."
End If
Set rs = Nothing
End With
No requery will be needed.
I hope you can assist. For some reason I can not think of what I am doing wrong. Maybe a fresh pair of eyes would help.
pulling GL's and their currency value from a query.
each GL needs to populate text boxes in a report with have sequential names. Ex: GL1, GL2, GL3, etc.
Each GL Value (currency) needs to populate other text boxes named uniquely. Ex: GLV1, GLV2, GLV3, GLV4, etc.
Here is my script - any help would be appreciated.
Dim rs As DAO.Recordset
Set rs = CurrentDb.OpenRecordset("SELECT * FROM qry_GL_totals")
Dim GLField As Variant
If Not (rs.EOF And rs.BOF) Then
rs.MoveFirst 'Unnecessary in this case, but still a good habit
RecordCount = 0
Do Until rs.EOF = True
RecordCount = RecordCount + 1
MsgBox (rs!GL & " " & rs!Expr1) 'MsgBox is just for testing
"[" & GLField & "]" =rs!GL
"[" & GLField & "T]" =rs!Expr1
rs.MoveNext
Loop
Else
End If
rs.Close
Set rs = Nothing
GLField = Null
End Sub
Update: This is what I have now and its failing still.
Private Sub Report_Load()
Dim rs As DAO.Recordset
Set rs = CurrentDb.OpenRecordset("SELECT * FROM qry_GL_totals")
If Not (rs.EOF And rs.BOF) Then
rs.MoveFirst
i = 0
Do Until rs.EOF = True
i = i + 1
Me.Controls(GLField) = rs!GL
Me.Controls(GLField & "T") = rs!Expr1
rs.MoveNext
Loop
Else
End If
rs.Close
Set rs = Nothing
End Sub
Run-time error "438" Object doesn't support this property or method.
Maybe try:
Me.Controls(GLField) = rs!GL
Me.Controls(GLField & "T") = rs!Expr1
For your updated code:
Me.Controls("GL" & i) = rs!GL
Me.Controls("GLV" & i) = rs!Expr1
assuming your controls are named "GL1", "GL2", "GLV1", "GLV2" etc
I would like to open a recordset using matching values within a column of a multiselect listbox. At the moment my code only opens and edits the last record of the selection and I would like it to open all of them. Here is my code:-
Set oRSAppt = Application.CurrentDb().OpenRecordset("Select * FROM [Appointments] WHERE [SlotID] =" & ListBox.Column(7, ListBox.ItemsSelected))
With oRSAppt
If .BOF = True And .EOF = True Then
MsgBox "No records found", , "Failed"
Exit Sub
Else
.MoveFirst
Do While Not .EOF
.Edit
.Fields("Status").Value = "Invoiced"
.Fields("InvoiceID").Value = vInvoiceID
.Update
.MoveNext
Loop
.Close
End If
End With
This link suggests a for loop to get the selected values from the listbox
http://msdn.microsoft.com/en-us/library/office/ff823015%28v=office.15%29.aspx
but I am not sure how to do this within the sql statement or whether I should even go about it this way - and maybe I've just been looking at this for so long I've missed an obvious solution. Any help would be appreciated.
You will need to build your SQL statement first and yes, you need to use a loop. Something like this should do the trick:
Dim strSQL as String
Dim vItm as Variant
Dim oRSAppt As DAO.Recordset
For Each vItm In Me!Listbox.ItemsSelected
strSQL = strSQL & ListBox.Column(7, vItm) & ","
Next vItm
strSQL = left(strSQL,len(strSQL) - 1) ' remove last comma
Set oRSAppt = CurrentDb.OpenRecordset("Select * FROM [Appointments] " _
WHERE [SlotID] In (" & strSQL & ")")