So, I've done this a million different ways but this is bothering me a bit. I'm trying to loop through a recordset, identify a number and compare to the next record. If they match, I want to change matching value. It seems to work, somewhat, but then I get all records as "Matched".... saying that there is 'No matched record'. I'm sure it's something dumb I'm missing so if anyone could point out my flaw here, that would be awesome! As always, thanks in advance!!!
con.Open _
"Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & App.Path & "\Books.mdb;" & _
"Jet OLEDB:Engine Type=4;"
rs1.Open "A", con, adOpenKeyset, adLockPessimistic, adCmdTableDirect
rs2.Open "B", con, adOpenKeyset, adLockPessimistic, adCmdTableDirect
rs1.MoveFirst
While Not rs1.EOF
rs2.MoveFirst
While Not rs2.EOF
If rs1("ID").Value = rs2("ID").Value Then
With rs2
!Matching_Criteria = "Matched"
.Update
End With
Else
With rs2
!Matching_Criteria = "UnMatched"
.Update
End With
End If
rs2.MoveNext
Wend
rs1.MoveNext
Wend
Be sure that bot of tables are in monopoly access for you and/or use static rst (I don't remember clearly)
Populate both of rst's:
.MoveLast
.MoveFirst
lCnt = .RecordsCount ' (engine wan't to format it ...)
Use For i = 1 to lCnt instead of While ... Wend
.
Related
I'm using a VBA procedure to add some fields to an existing table by modifying its TableDef.
As the names of these fields could change between imports, I opted to delete the old entries before adding new ones.
The code below has no problem adding the fields from the library table (P6 Files AC).
Where it goes wrong is in deleting existing entries. The count at the beginning always gives the correct number of fields. But the FOR EACH statement jumps over some of the entries.
Running the code repeatedly, ultimately does delete all of the field that meet the criteria.
Set curdb = CurrentDb()
Set tdf = curdb.TableDefs("TASK")
Debug.Print tdf.Fields.Count
tdf.Fields.Refresh
For Each fld In tdf.Fields
Debug.Print fld.Name
If InStr(1, fld.Name, "AC#", vbTextCompare) > 0 Then tdf.Fields.Delete fld.Name
Next fld
'add the field from the P6 Files AC table
strSQL = "SELECT [P6 Files AC].Field_Name " & _
"FROM [P6 Files AC] " & _
"ORDER BY [P6 Files AC].Field_Name;"
Set newfields = curdb.OpenRecordset(strSQL, dbOpenSnapshot)
With newfields
Do Until .EOF()
tdf.Fields.Append tdf.CreateField(!field_name, dbText, 15)
.MoveNext
Loop
End With
I think it would be much simpler to link the source table, then use it as source in a create-table query:
SELECT *
INTO [TASK]
FROM [P6 Files AC];
It will overwrite an existing TASK table.
When you loop a collection of items, such as fields in a table, to delete them, you need to do so in reverse order, otherwise the current field positions get out of sync to those being considered in your loop. Try something like:
Sub sDeleteFields()
On Error GoTo E_Handle
Dim db As DAO.Database
Dim tdf As DAO.TableDef
Dim lngCount As Long
Dim lngLoop1 As Long
Set db = CurrentDb
Set tdf = db.TableDefs("tblRatings")
lngCount = tdf.Fields.Count - 1
For lngLoop1 = lngCount To 0 Step -1
If InStr(tdf.Fields(lngLoop1).name, "AC#") > 0 Then
tdf.Fields.Delete tdf.Fields(lngLoop1).Name
End If
Next lngLoop1
tdf.Fields.Refresh
sExit:
On Error Resume Next
Set tdf = Nothing
Set db = Nothing
Exit Sub
E_Handle:
MsgBox Err.Description & vbCrLf & vbCrLf & "sDeleteFields", vbOKOnly + vbCritical, "Error: " & Err.Number
Resume sExit
End Sub
Note that fields are 0-indexed, so the first field is at position 0, and the last field is at position count-1.
Regards,
Is it possible to use DoCmd.GoToRecord or DoCmd.FindRecord in order to quickly find a record in a table, edit the record and get the focus on that record (I want to start looping from that record later)?
I believe such method (if applicable) would be faster than looping through the entire recordset (especially with a large recordset).
Assuming the Primary key is 9999 (Fields(0) = 9999), I have tried:
Dim rs as DAO.Recordset
Set rs = CurrentDb.OpenRecordset("Tbltest")
DoCmd.FindRecord "9999", acEntire, True, acSearchAll, True
Debug.Print rs.Fields(0)
I get "1"; the method failed.
With a DAO.Recordset, you use the rs.FindFirst and rs.FindNext methods.
Set rs = CurrentDb.OpenRecordset("Tbltest", dbOpenDynaset)
lngValue = 9999
rs.FindFirst "myPrimaryKey = " & lngValue
' start loop from there
If Not rs.NoMatch Then
Do While Not rs.EOF
Debug.Print rs(0)
rs.MoveNext
Loop
End If
If it's a local table, there is also the rs.Seek method, but if there is a chance that the table will some day be linked from a backend or server database, I suggest sticking with the Find methods.
Im trying to get rows from the columns in a recordset and then insert those in a table plain and simple.
The recordset is populated and i used .MoveFirst to start at the beginning of the rs, Still i get EOF true at the very start and it jumps out of the do while..
I have a similar function woorking but this one won't woork for some reason.
I can't figureout why... or how to fix this. Anny insight is welcome!
current Code ~
Public Function makeSäljare()
'Create rs
Dim rsData As ADODB.Recordset
Set rsData = New ADODB.Recordset
Dim sql As String
'Select what should be included in the rs.
rsData.Open "SELECT Forhandler, Selger FROM data", _
CurrentProject.Connection, adOpenDynamic, adLockOptimistic
rsData.MoveFirst
MsgBox rsData.GetString
'Manipulate each row of the result column.
Do While Not rsData.EOF
sql = "INSERT INTO säljare (Partner_Namn, Namn ) VALUES ('" & rsData!forhandler & "','" & rsData!Selger & "');"
MsgBox sql
'DoCmd.SetWarnings (False)
DoCmd.RunSQL (sql)
'DoCmd.SetWarnings (True)
rsData.MoveNext
'If rsData.EOF Then Exit Do
Loop
rsData.Close
End Function
It jumps out at Do While Not rsData.EOF..
GetString leaves the recordset at EOF. MoveFirst again before Do While Not rsData.EOF
rsData.MoveFirst
MsgBox rsData.GetString
rsData.MoveFirst ' <-- add this
'Manipulate each row of the result column.
Do While Not rsData.EOF
I didn't try your code, but this logically means that the recordset is empty.
Check carefully if the query you executed on the db is correct.
In Access, use DAO instead of ADO and try this:
Set db = CurrentDb
set rsData = db.OpenRecordset("SELECT Forhandler, Selger FROM data", dbOpenDynaset)
Help! I have a database that I'm using to open an Excel template, export the results of a QueryDef to the acitve worksheet, then save that file with a new file name. Sounds easy enough. The problem that I'm running into is getting the results to export into an active worksheet by using DoCmd.TransferSpreadsheet. It does everything that I need it to, except for actually transfering the data... Which means, it's pretty much useless. Any help would be GREATLY appreciated. I'm about to pull my hair out. Thank you in advance.
Creating the QDF
Set qdf = db.CreateQueryDef("" & strCrt, "SELECT [Zones Asset Information].* FROM " & _
"[Zones Asset Information] WHERE [Zones Asset Informaiton].[Invoice Number] " = '" & strCrt & "';")
Opening the Template
Set xlWB = xlApp.Workbooks.Open(WB_PATH)
Set xlWS = xlWB.Sheets(3)
xlWS.Activate
Trying to Export
DoCmd.TransferSpreadsheet acExport, 10, "" & strCrt, , True, "orig data" 'Don't know how to specify Active Worksheet instead of a filename?!?
DoCmd.DeleteObject acQuery, "" & strCrt
Saving the File
sSaveAsFileName = FLDR_PATH & "Accounting_Breakdown_Zones_Invoice_xxxxxx.xlsx"
Debug.Print "sSaveAsFileName: " & sSaveAsFileName
xlWB.SaveAs sSaveAsFileName
There are two ways of exporting data from Access to Excel:
Opening an MsExcel object and using its methods to manipulate the Excel
Exporting data using the TransferSpreadsheet method
You are doing a mix of both, which is why you are not getting the result.
TransferSpreadsheet will export the given query to the specified file, but you cannot specify the worksheet.
If specifying worksheet is important, you will have to do it with an Excel object, and send the information cell by cell, a lot more work, if it justifies the cause.
E Mett, Thank you for the direction. Had to rework the process which doesn't 100% agree with the post title now, but thought I would share in case anyone else needed something similar. Thanks again!!
Private Sub ExportTable_MultipleWB()
Dim db As DAO.Database, rs As DAO.Recordset, rs2 As DAO.Recordset, strFilter As String, strFilter2 As String, _
sSaveAsFileName As String
Dim xlApp As Excel.Application, xlWB As Excel.Workbook, xlWS As Excel.Worksheet
Dim bolIsExcelRunning As Boolean
Set db = CurrentDb
Set rs = db.OpenRecordset("SELECT DISTINCT [mytable].[PO Number], [mytable].[Invoice Number] " & _
"FROM [mytable] ORDER BY [mytable].[PO Number], [mytable].[Invoice Number];", dbOpenSnapshot)
rs.MoveFirst
Do While Not rs.EOF
strFilter = rs.Fields(1).Value
strFilter2 = rs.Fields(0).Value
Set rs2 = db.OpenRecordset("SELECT [mytable].* FROM [mytable] WHERE [mytable].[Invoice Number] = '" & strFilter & "';")
On Error Resume Next
Set xlApp = GetObject(, "Excel.Application")
If Err.Number <> 0 Then
Set xlApp = CreateObject("Excel.Application")
Else
bolIsExcelRunning = True
End If
xlApp.Visible = True
Set xlWB = xlApp.Workbooks.Open(WB_PATH)
Set xlWS = xlWB.Sheets(3)
xlWS.Activate
With xlWS
For iCols = 0 To rs2.Fields.Count - 1
xlWS.Cells(1, iCols + 1).Value = rs2.Fields(iCols).Name
Next
xlWS.Range(xlWS.Cells(1, 1), _
xlWS.Cells(1, rs2.Fields.Count)).Font.Bold = True
xlWS.Range("A2").CopyFromRecordset rs2
End With
sSaveAsFileName = FLDR_PATH & "myfilename_" & strFilter & "_PO-" & strFilter2 & ".xlsx"
Debug.Print "sSaveAsFileName: " & sSaveAsFileName
xlWB.SaveAs sSaveAsFileName
Set xlWS = Nothing
xlWB.Close False
Set xlWB = Nothing
rs.MoveNext
Loop
rs.Close
rs2.Close
If Not bolIsExcelRunning Then
xlApp.Quit
End If
Set xlApp = Nothing
Set rs = Nothing
Set rs2 = Nothing
Set db = Nothing
End Sub
I'm performing a data cleansing operation on an access database. I have several duplicate records in a table that I want to consolidate down into one single record. In doing this I will need to update all references to the records that I will be consolidating.
If I know the column name that holds the record id is there a way to find all of the tables in access that contain this column?
You can examine the TableDefs collection and determine which tables contain a field with a given name.
Public Sub TablesWithField(ByVal pName As String)
Dim db As DAO.Database
Dim tdf As DAO.TableDef
Dim strMsg As String
Dim strName As String
On Error GoTo ErrorHandler
Set db = CurrentDb
For Each tdf In db.TableDefs
strName = vbNullString
'ignore system and temporary tables '
If Not (tdf.name Like "MSys*" Or tdf.name Like "~*") Then
strName = tdf.Fields(pName).name
If Len(strName) > 0 Then
Debug.Print tdf.name & ": " & pName
End If
End If
Next tdf
ExitHere:
On Error GoTo 0
Set tdf = Nothing
Set db = Nothing
Exit Sub
ErrorHandler:
Select Case Err.Number
Case 3265 'Item not found in this collection. '
Resume Next
Case Else
strMsg = "Error " & Err.Number & " (" & Err.description _
& ") in procedure TablesWithField"
MsgBox strMsg
GoTo ExitHere
End Select
End Sub
Short answer: Yes. And there are many ways to skin that cat. Two ideas:
(1) Via VBA, make use of: Application.CurrentDb.TableDefs(i).Fields(j).Name
(2) Via Tools==>Analyze==>Documenter, make a report and then search its output (Publish it with MS Word).
Sorry, but Access isn't built like MS SQL Server or DB2 - the MSys* tables really aren't set up for querying table schemas like that. However, others have VBA based solutions that look useful.
You can use Schemas, not exactly a query, but similar:
Function ListTablesContainingField(SelectFieldName) As String
'Tables returned will include linked tables
'I have added a little error coding. I don't normally do that
'for examples, so don't read anything into it :)
Dim cn As New ADODB.Connection
Dim rs As ADODB.Recordset
Dim strTempList As String
On Error GoTo Error_Trap
Set cn = CurrentProject.Connection
'Get names of all tables that have a column called <SelectFieldName>
Set rs = cn.OpenSchema(adSchemaColumns, _
Array(Empty, Empty, Empty, SelectFieldName))
'List the tables that have been selected
While Not rs.EOF
'Exclude MS system tables
If Left(rs!Table_Name, 4) <> "MSys" Then
strTempList = strTempList & "," & rs!Table_Name
End If
rs.MoveNext
Wend
ListTablesContainingField = Mid(strTempList, 2)
Exit_Here:
rs.Close
Set cn = Nothing
Exit Function
Error_Trap:
MsgBox Err.Description
Resume Exit_Here
End Function