All tables in a certain database have the exact columns, so I'm wondering if there is a way I can query all of them at once for a specific few columns that I know every table will have. The reason I want to do this is that the number of tables in the database will constantly be growing, and I don't want to have to every day go and change my query to accommodate the names of the new tables.
Help is appreciated as always
In that case, try ADO:
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
From: http://wiki.lessthandot.com/index.php/ADO_Schemas
You might like to consider a table of tables, if you have not already got one, that lists the linked Excel tables and holds details of archive dates etc, because you will run into limits at some stage.
Related
I have a table tblPartnerships structured as
ID Partnerships
1 Finance, IT, Operations
2 Legal, Compliance, IT, HR
I need to extract all of the comma separated keywords from Partnerships column and put it in another mastertable with each word as a separate row so that it shows up as
Finance
IT
Operations
Legal
Compliance
IT
HR
I know there is a split function such as varList = Split(stTmp, ",") but i am completely lost how to iterate through the entire column tblPartnerships.Partnerships insert it into MasterTable.Rowheading
Any Access query or vba code will be highly appreciated
Create an Append query with a single parameter, the word to be imported. The query's source SQL should be something like this:
PARAMETERS [prmWord] Text (50);
INSERT INTO T ( Words )
SELECT [prmWord] AS _Word;
Where T is the name of your Table (master) and Words is the name of the Field.
Then just loop through the Partnerships recordset, split the value and import each word using the above query.
Sub SplitAndImport()
On Error GoTo ErrorTrap
Dim rs As DAO.Recordset
Set rs = CurrentDb().OpenRecordset("SELECT Partnerships FROM tblPartnerships;", dbOpenSnapshot)
With rs
If .EOF Then GoTo Leave
.MoveLast
.MoveFirst
End With
Dim arr As Variant
Dim i As Long, ii As Long
For i = 1 To rs.RecordCount
arr = Split(rs![Partnerships], ",")
For ii = LBound(arr) To UBound(arr)
With CurrentDb().QueryDefs("QueryName")
.Parameters("[prmWord]").Value = Trim(arr(ii))
.Execute dbFailOnError
End With
Next
rs.MoveNext
Next
Leave:
If Not rs Is Nothing Then rs.Close
On Error GoTo 0
Exit Sub
ErrorTrap:
MsgBox Err.Description, vbCritical
Resume Leave
End Sub
This may not work as accurately with your current database design.
You may try using multivalued fields. Later, if you want view multi values each on single row then use "AssignedTo" command.
SELECT [title], [lcs].[AssignedTo].[value] AS Expr1
FROM Product;
Where lcs is a multivalued field and title is a text field.
I have a table subform containing jobs to be completed. I'm creating an algorithm in VBA to organize the jobs in the most efficient order to be completed.
Is there a way to move an individual record in a recordset or am I stuck with OrderBy?
Edit:
To add some clarity, I want to be able to move a record to any other index in the same table. I intend to run my algorithm which will move the records into the order they are to be completed. Then each records' "Process Date" field is set to keep track of the order.
The short answer is "No", the index of a record in a recordset cannot be directly updated. The order of rows in a recordset can only be changed by either setting a different ORDER BY clause and requerying the database, or by setting the Recordset.Sort property or the Form.OrderBy property (when bound to a form).
Let's assume that there is a updatable recordset field called [JobOrder]. The SQL source query can include a sort order like ... ORDER BY [JobOrder] ASC which first sorts the data when it is retrieved from the database. As a matter of fundamental database concept, it should be assumed that if no ORDER BY clause is specified that the database can return data in a random order. (In practice that is not usually the case. It will be sorted by some indexed primary key by default, but that should not be assumed if the order is important.)
The form's (or subform's) sort order can be set and changed without requerying the data from the database again. That is done by setting the OrderBy property and ensuring that OrderByOn = True. (FYI: Unless you take measures to hide default tool ribbons (i.e. toolbars) and shortcut menus, this sort order can be altered by the user.)
Now your VBA code can use various techniques to set the JobOrder values. You could perhaps use the Me.RecordsetClone method to enumerate and update the values using the recordset object. Using RecordsetClone will avoid certain side effects of updating the bound primary recordset. Lastly, the following assumes that all records already have valid, unique JobOrder values, but it assumes that JobOrder is not required to be unique (since the swap technique temporarily sets two rows to the same value). It's up to you to write your own clever implementation to guarantee that JobOrder values remain valid and unique.
Private Sub MoveCurrentUp()
Dim rs As Recordset2
Dim thisID As Long
Dim thisSort As Long
Dim previousID As Long
Dim previousSort As Long
On Error Resume Next
'* Error handling to avoid cases where recordset is empty
'* and/or the current record is not valid (i.e. new record)
If Not IsNull(Me.ID.Value) Then
thisID = Me.ID.Value
If Err.Number = 0 Then
On Error GoTo Catch
'* Any errors from this point should be
'* handled specifically rather than ignored
Set rs = Me.RecordsetClone
rs.FindFirst "ID=" & thisID
If Not rs.NoMatch Then
thisSort = rs!JobOrder
rs.MovePrevious
If Not rs.BOF Then
previousID = rs!ID
previousSort = rs!JobOrder
rs.Edit
rs!JobOrder = thisSort
rs.Update
rs.MoveNext
rs.Edit
rs!JobOrder = previousSort
rs.Update
Set rs = Nothing
RefreshSort
End If
End If
Set rs = Nothing
Debug.Print Me.Sort
End If
End If
Exit Sub
Catch:
MsgBox "Error updating order." & vbNewLine & vbNewLine & _
" " & Err.Number & ": " & Err.Description, vbOKOnly Or vbExclamation, "Error"
End Sub
Aferward, you would refresh the form's sort order with something like:
Private Sub RefreshSort(Optional restoreCurrentRecord As Boolean = True)
Dim rs As Recordset2
Dim saveID As Long
saveID = Me.ID.Value
Me.OrderBy = "[JobOrder] ASC"
Me.OrderByOn = True
If restoreCurrentRecord Then
Set rs = Me.RecordsetClone
rs.FindFirst "ID=" & saveID
If Not rs.NoMatch Then
Me.Bookmark = rs.Bookmark
End If
Set rs = Nothing
End If
End Sub
Or you could update rows using SQL queries, then call Me.OrderByOn = False then Me.Requery to force the entire recordset to be reloaded in the proper order (assuming the record source has a proper ORDER BY clause). This technique has the benefit of wrapping all the changes in a transaction which can be committed or rolled back altogether, something you can't do with the bound form's recordset objects.
Who can help a beginner out. I've added two screenshots to make my story clearer.
My excel sheet is two tabs. One is 'calculation' and other is 'project'.
What i'd like to know is how to program the following in vba:
In the calculation tab there is a employee number in column E. I have to look if that number also is written in the projects tab. If so i need to know if the date of the calculation tab falls within the start and end date in the projects tab. If so then write the info if that row to the empty columns in the calculation tab.
Another problem arises when an employee works multiple jobs in the projects tab. I guess there needs to be another loop in here:
If the date from calculation tab doesn't fall in the period from start to end in the projects tab, is there another row with the same employee number and maybe it falls within that period.
I hope i made my story clear. I know what the steps should be, just not how to program it. I hope someone is able to help me with this.
Since your screenshots appear to be Excel for Windows consider an SQL solution using Windows' JET/ACE Engine (.dll files) as you simply need to join the two worksheets with a WHERE clause for date filter. In this approach you avoid any need for looping and use of arrays/collections.
To integrate below, add a new worksheet called RESULTS as SQL queries on workbooks are read-only operations and do not update existing data. A LEFT JOIN is used to keep all records in Calculations regardless of matches in Projects but matched data will populate in empty columns. Results should structurally replicate Calculations. Adjust column names in SELECT, ON, and WHERE clauses as required (as I cannot clearly read column names from screenshots). Finally, a very important item: be sure date columns are formatted as Date type.
Dim conn As Object, rst As Object
Dim strConnection As String, strSQL As String
Dim i As Integer
Set conn = CreateObject("ADODB.Connection")
Set rst = CreateObject("ADODB.Recordset")
' OPEN DB CONNECTION
strConnection = "DRIVER={Microsoft Excel Driver (*.xls, *.xlsx, *.xlsm, *.xlsb)};" _ '
& "DBQ=C:\Path\To\Workbook.xlsx;"
conn.Open strConnection
' OPEN QUERY RECRDSET
strSQL = "SELECT t1.*, t2.[Project] AS [Which Project], t2.[Customer] As [Which Customer]," _
& " t2.[Start], t2.[End planned], t2.[Hours per week]" _
& " FROM [Calculation$A$3:$D$1048576] t1" _
& " LEFT JOIN [Projects$A$3:$J$1048576] t2" _
& " ON t1.EmployeeNum = t2.EmployeeNum" _
& " WHERE t1.[Date] BETWEEN t2.Start AND t2.[End planned];"
rst.Open strSQL, conn
' COLUMNS
For i = 1 To rst.Fields.Count Worksheets("RESULTS").Cells(3, i) =
rst.Fields(i - 1).Name
Next i
' DATA ROWS
Worksheets("RESULTS").Range("A4").CopyFromRecordset rst
rst.Close
conn.Close
Set rst = Nothing
Set conn = Nothing
it would be great to let us know, what you have done so far. I think the easiest way for a beginner is to just use two loops. One for the calculation and one for the projects tab.
Then you can start to develop your functionality. Use a "row counter" for each worksheet and iterate trough the rows. Here is an example pseudo code:
Dim lRowCountCalc as Long
Dim lRowCountPrj as Long
lRowCountCalc = 1
lRowCountPrj = 1
do
do
If Table2.Range("A" & lRowCountPrj).Value = Table1.Range("E" & lRowCountPrj).Value Then
If ... dates are equal
'Do some stuff
End if
End If
lRowCountPrj = lRowCountPrj +1
Loop Until lRowCountPrj = 5000 Or Table2.Range("A" & lRowCountPrj).text = ""
lRowCountCalc = lRowCountCalc +1
Loop Until lRowCountCalc = 5000 Or Table1.Range("A" & lRowCountCalc).text = ""
Just check for each employee number in calculation if there is a the same number in the current row in projects. If so, do your checks and fill in the information you need. If there is more than one project, you will find it also because all rows will be checked.
But be careful. This is very expensive because this code iterates for each row in projects over all rows in calculation. But for the beginning I would do it like this.
One aspect of my project involves comparing the part number entered by the operator to a predetermined list of part numbers in a column in a database. Right now, my program is telling me that every part number entered in the spreadsheet (50+) does not match any in the database, which I've verified to be incorrect. I've checked that both the spreadsheet part number and the database part number are of string datatype. I've doublechecked that my looping logic is good, and to me seems like it should work. To the best of my knowledge there are no hidden characters in either the database cells or in the spreadsheet cells. I'm completely stumped at this point as to why my program doesn't detect any matches between the spreadsheet and the database. Below is the Sub containing the code for checking that the part numbers match:
Sub CheckPN()
'Connect to the E2 database
Call SetPNConnection
'Open a recordset
Set PNRecordset = New ADODB.Recordset
PNRecordset.Open "EstimRpt", PNConnection, adOpenKeyset, adLockOptimistic, adCmdTable
PNSQLCmd = "SELECT DISTINCT [PartNo] FROM EstimRpt;"
'Loop through data, comparing part numbers to E2 database part number records
TotalBadPNCount = 0
With PNRecordset
For DataRowCount = 2 To TrackingLastRow
PNCount = 0
Part_Number = Tracking.Sheets("Operator Data").Range("A" & DataRowCount).Value
'MsgBox "The datatype for " & Part_Number & " is " & VarType(Part_Number) & "."
Do Until .EOF
'MsgBox "The datatype for " & .Fields("PartNo").Value & " is " & VarType(.Fields("PartNo").Value) & "."
If Part_Number = .Fields("PartNo").Value Then
'If .Fields("PartNo").Value = Part_Number Then
MsgBox Part_Number & " is a match."
PNCount = PNCount + 1
End If
.MoveNext
Loop
If PNCount < 1 Then
MsgBox "The P/N " & Part_Number & " entered in cell A" & DataRowCount & " is incorrect. Please correctly enter the P/N and re-run the program."
TotalBadPNCount = TotalBadPNCount + 1
End If
Next DataRowCount
If TotalBadPNCount >= 1 Then
Exit Sub
End If
End With
PNRecordset.Close
Set PNRecordset = Nothing
PNConnection.Close
Set PNConnection = Nothing
End Sub
On a side note, I'd like to have the entire program stop executing if a part number doesn't match, not just the immediate sub. Currently, just this sub exits upon no part number matches.
Thanks for the help on both of these issues.
Jordan
I'd suggest not using a loop to compare records from your user-submitted dataset to your permanent table. Instead, load the user-submitted dataset into a temporary table in your DB, and use SQL to compare the 2 tables.
You can try something along these lines:
'Load spreadsheet into temp table
<your code here>
'open recordset in order to compare PartNos
Dim db As Database
Set db = CurrentDb
Dim rs As Recordset
sSQL = "select count(*) as [count] from temp " _
& " where temp.PartNo not in (select distinct EstimRpt.PartNo from EstimRpt)"
Set rs = db.OpenRecordset(sSQL)
ctRecords = rs![Count]
'if records are found in temp table that do not exist
'in the perm table, then end execution of everything.
if ctRecords > 0 then
End
else
'run the rest of your code
<your code here>
end if
'Drop temp table
<your code here>
I found my problem at long last. The comparing records between database and spreadsheet does work now. I had to make the following changes to my code:
Instead of:
Do Until .EOF
I needed:
Do Until .EOF = True
I also needed to add the following just after the For Loop declaration:
.MoveFirst
Now my code loops correctly.
I'm relatively experienced with Object oriented programming, but this is my first time ever working in Office with VBA and I'm entirely stumped by the syntax. I've been doing some searching and messing with it for the past hour or so, but have been trouble actually getting a macro that runs successfully and does what I need.
I'm attempting to loop through every cell in an Access table and apply the Trim function to the contents of that cell and, as a bonus, I'd like to remove all extra spaces in the string (if any). I.e. " Trim this__string " would simply become "Trim this string" (I used the underscore there to represent individual, multiple spaces since StackOverflow didn't want to show my multiple spaces).
Any code example of doing something like this, or at least something to get me close and then I can tinker with it, would be greatly appreciated. Thanks!
You can remove leading and trailing spaces with the Trim() function in a query.
UPDATE YourTable
SET text_field = Trim(text_field);
If you will be doing this from within an Access session, you could use Replace() to replace a sequence of two spaces with a single space.
UPDATE YourTable
SET text_field = Replace(text_field, ' ', ' ');
However you may need to run that Replace() query more than once to get all the contiguous space characters down to only one.
You could also do a regular expression-based replacement with a user-defined function. I don't know if that's worth the effort, though. And a user-defined function is also only available from within an Access application session.
I overlooked the "every cell in a table" aspect. That makes this more challenging and I don't think you can solve it with a standard macro or query. You can however use VBA code to examine the TableDef, and iterate through its fields ... then call your Trim and/or Replace operations on any of those fields whose data type is text or memo.
Here's a rough code outline to identify which fields of a given table are text type.
Public Sub FindTextFields(ByVal WhichTable As String)
Dim db As DAO.Database
Dim tdf As DAO.TableDef
Dim fld As DAO.Field
Set db = CurrentDb
Set tdf = db.TableDefs(WhichTable)
For Each fld In tdf.Fields
If fld.Type = dbText Or fld.Type = dbMemo Then
Debug.Print "Do something with " & fld.Name
End If
Next
Set fld = Nothing
Set tdf = Nothing
Set db = Nothing
End Sub
Option Compare Database
Private Sub Command3_Click()
Call findField(Text1.Value)
End Sub
Public Function findField(p_myFieldName)
Dim db As Database, _
tb As TableDef, _
fd As Field
'''''''''Clearing the contents of the table
DoCmd.RunSQL "delete * from Field_Match_Found"
Set db = CurrentDb
For Each tb In db.TableDefs
For Each fd In tb.Fields
If fd.Name = p_myFieldName Then
strsql = "INSERT INTO Field_Match_Found Values (""" & tb.Name & """, """ & fd.Name & """)"
DoCmd.RunSQL strsql
End If
Next fd
Next tb
Set fd = Nothing
Set tb = Nothing
Set db = Nothing
If DCount("Account_number", "Field_Match_Found") = 0 Then
MsgBox ("No match was found")
Else
MsgBox ("Check Table Field_Match_Found for your output")
''''''''''making textbox blank for next time
Text1.Value = ""
End Function