Dlookup passing incorrect value - vba

I am using DLookup
Dim FormName As String
Dim OldBBusinessterm As Long
Dim field As Long
Dim NewBusinessTerm As String
Dim NewRecord As DAO.Database
Dim rstUpdate As DAO.Recordset
oldbusinessterm = Me!BusinessTermID.OldValue 'equal 5194 in test
NewBusinessTerm = Me!BusinessTermID.Value ' equal 5195 in test
BusinessTerm = DLookup("[businesstermdesc]", "tblbusinessterm", " [businesstermid] =" & oldbusinessterm)
' here is the issue - [businesstermid] = 5195 - it should be setting the value from Oldbusinessterm but it is populating it from New businessterm
Set NewRecord = CurrentDb
Set rstUpdate = NewRecord.OpenRecordset("TblFieldTermLink")
rstUpdate.AddNew
rstUpdate("GTSBusinessTerm").Value = BusinessTerm
rstUpdate("BusinessTermID").Value = Me!BusinessTermID.Value
rstUpdate.Update
My problem is that it is reading the businesstermID from my open form, instead of doing the dlookup using the old value.
Any ideas as to why

When you are adding a new record to table TblFieldTermLink you are using the new BusinessTermID value. If you want the Old value you should modify your code to reflect that:
rstUpdate.AddNew
rstUpdate("GTSBusinessTerm").Value = BusinessTerm 'String Text describing old BusinessTermID
rstUpdate("BusinessTermID").Value = oldbusinessterm 'Long Value of old BusinessTermID
rstUpdate.Update
I also notice that you are not using the variable you declared to hold the old business term id:
Dim OldBBusinessterm As Long
oldbusinessterm = Me!BusinessTermID.OldValue 'equal 5194 in test
Notice the spelling of the two. Which is why capitalization did not follow. Perhaps you want to correct the Dim statement:
Dim OldBusinessTerm As Long

Related

Subscript not in Range MS Access

I'm needing to get fields names from a query and put them into a dynamic array. I believe I have found the proper code this, however I get a "Subscript not in Range" error.
Code so far:
Dim qdf As QueryDef
Dim fld As Field
Dim o As Integer
Dim fieldCount as Integer
fieldCount = CurrentDb.QueryDefs("qryctAverage").Fields.Count
Set qdf = db.QueryDefs("qryctAverage")
Dim n As Integer
n = fieldCount
ReDim colHeaders(0 To n - 1)
For o = 0 To n - 1
colHeader(o) = qdf.Fields(o).Name
Next o
Line of error: colHeader(o) = qdf.Fields(o).Name
I'm fairly new to VBA so I appreciate the patience and time put in to helping out! Thanks in advance
Note: All answer I've found have applied to non-dynamic arrays.
EDIT:
I now get "Sub or Function not defined" after removing Dim colHeader() as String
Error Line: colHeader(o) = qdf.Fields(o).Name
Dim colHeader() As String
ReDim colHeaders(0 To n - 1)
You've declared colHeader, but resized colHeaders. Option Explicit can't pick that up, because the ReDim statement is perfectly valid as a declaration, too.
But then, colHeader isn't dimensioned, so index o is necessarily out of bounds:
colHeader(o) = qdf.Fields(o).Name
Change it to
colHeaders(o) = qfd.Fields(o).Name
I'd remove the Dim colHeader() As String declaration, and add Option Explicit at the top of the module if it's missing.
Another way would be to use a For Each block.
This code builds a single string of field names separated by an |.
Split is then used to turn the field string into an array of field names which is passed back to the calling procedure.
Option Explicit
Sub Test()
Dim colHeaders As Variant
colHeaders = FieldNames("qryctAverage")
Debug.Assert False 'Pause code so you can look at colHeaders.
End Sub
Public Function FieldNames(QueryName As String) As Variant
Dim qdf As DAO.QueryDef
Dim fld As DAO.Field
Dim fldNames As String
Set qdf = CurrentDb.QueryDefs(QueryName)
For Each fld In qdf.Fields
fldNames = fldNames & fld.Name & "|"
Next fld
fldNames = Left(fldNames, Len(fldNames) - 1)
FieldNames = Split(fldNames, "|")
End Function

CATIA VBA Measure a user selected line(s)/spline

I am trying to get the length of user selected lines/splines
This is the code I'm using to have users select their lines:
Dim USel As Selection
Dim USelLB
Dim InputObject(0)
InputObject(0) = "AnyObject"
Set USel = CATIA.ActiveDocument.Selection
Set USelLB = USel
USel.Clear
USelLB.Clear
Linestomeasure = USelLB.SelectElement3(InputObject, "Select objects to list names", True, CATMultiSelTriggWhenUserValidatesSelection, False)
Linestomeasure is a public variable, in the mainsub i've been trying to measure Linestomeasure using the following code:
Dim pd1 As PartDocument
Dim a As Object
Dim c As Reference
a = TrimLines.Item(1)
c = pd1.Part.CreateReferenceFromObject(a)
Dim Mea1 As Measurable
Dim TheSPAWorkbench As SPAWorkbench
Set TheSPAWorkbench = pd1.GetWorkbench("SPAWorkbench")
Set Mea1 = TheSPAWorkbench.GetMeasurable(c)
But when I run the code a = trimLines.Item(1) gets highlighted in the debugger with the error message "Object Required".
Does anyone have an idea on how I can change my code so that I can get the length of the line as a variable that I can work with ? Or just a different way to go about what I'm trying to do?
Edited answer to reflect comment bellow
Looks like you are assigning the wrong type of variable to the USelLB.SelectElement3 and also missunderstanding how it actually works.
The Selection.SelectElement3 returns a String that reflects whether the selection was sucessfull or not.
The Object retrieved from the Selection is inside the Selection.Item(Index)
Your code should be something like this:
Dim PD1 as PartDocument
Dim Sel 'as Selection 'Sometimes it is needed to comment the selection to use the .SelectElement3 method
Dim InputObjType(0)
Dim SelectionResult as string
Dim LineToMeasure as AnyObject
Dim I as Integer
Dim SpaWorkbench as SPAWorkbench
Dim Measurable as Measurable
InputObjType(0) = "AnyObject"
'set PD1 = Catia.ActiveDocument
set Sel = PD1.Selection
Set TheSPAWorkbench = pd1.GetWorkbench("SPAWorkbench")
Sel.Clear
SelectionResult= Sel.SelectElement3(InputObject, "Select objects to list names", True, CATMultiSelTriggWhenUserValidatesSelection, False)
If SelectionResult = "Ok" or SelectionResult = "Normal" then 'Check if user did not cancel the Selection
For i = 1 to Selection.Count
Set LineToMeasure = Sel.Item(i).Value
set Measurable = SpaWorkbench.GetMeasurable(LineToMeasure)
'Measure whatever you need here.
Next
End If
Keep in mind that using the AnyObject type filter may cause the user to select unwanted objects. You shoudl use a more specific filter.

How to get the Design Last modified date of the Database using Lotus Script?

I want to get the Design Last modified(Not Database modified) date of the database using lotus script. I can get the Design last modified date from the catalog.nsf, But I need to take it from the database.
Look in database for every design element when it was last modified and take the most recent.
You can get all design elements with NotesNoteCollection. As design elements are NotesDocuments you can get the last modified date with doc.LastModified.
This is an example for an agent where you can choose a database and get printed the design last modified date:
Dim workspace As New NotesUIWorkspace
Dim session As New NotesSession
Dim db As NotesDatabase
Dim nid As String
Dim i As Integer
Dim doc As NotesDocument
Dim designLastModified As Variant
Dim serverDatabase As variant
serverDatabase = workspace.Prompt(13, "Choose Database", "")
If IsEmpty(serverDatabase) Then Exit Sub
Set db = session.Getdatabase(serverDatabase(0), serverDatabase(1), false)
Dim nc As NotesNoteCollection
Set nc = db.CreateNoteCollection(False)
Call nc.SelectAllDesignElements(True)
Call nc.BuildCollection
designLastModified = 0
nid = nc.GetFirstNoteId
For i = 1 To nc.Count
Set doc = db.GetDocumentByID(nid)
If Not doc Is Nothing then
If designLastModified < doc.LastModified Then
designLastModified = doc.LastModified
End If
End if
nid = nc.GetNextNoteId(nid)
Next
Print "Design last modified: " & designLastModified
It prints exactly the time shown in field "Design last modified date:" in catalog.nsf for selected database.

How to query a delimited value list generated by function (Access)

I've got a module sub getFileList() that generates a value list that outputs the following:
10347 C;12-0605 TPX;12-0713 tpx;13-0915 tpx;13-4304 tpx;1345 c;1375 c;14-4201 tpx;
I wanted to build a query against this function.
In the SQL view I've got the following:
SELECT getFileList("\\wwdata\dev\_commons\color","*.jpg") as colors;
Right now the value list is all in one record.
Colors
10347 C;12-0605 TPX;12-0713 tpx; etc....
What function/command is available to make this into a list with each delimited item as a record.
Desired output.
Colors
10347 C
12-0605 TPX
12-0713 tpx
13-0915 tpx
13-4304 tpx
1345 c
etc....
Thanks in advance.
For me, personally, I'd prefer to parse that delimited string in to an actual table in Access, and then run whatever query you want off that.
The following assumes there's already an empty table called "tblColors" and a short text field in that table called "Colors", which will be the target for parsing each ";" delimited item in your string into its own record in that table:
Private Sub Command0_Click()
Dim myDelimStr As String
Dim arrayToParse As Variant
Dim i As Integer
Dim arrayMsg As String
Dim db As DAO.Database
Dim rs As DAO.Recordset
Set db = CurrentDb
Set rs = db.OpenRecordset("tblColors")
myDelimStr = "10347 C;12-0605 TPX;12-0713 tpx;13-0915 tpx;13-4304 tpx;1345 c;1375 c;14-4201 tpx;"
arrayToParse = Split(myDelimStr, ";", -1, vbTextCompare)
For i = 0 To UBound(arrayToParse) - 1
rs.AddNew
rs("Colors").Value = arrayToParse(i)
rs.Update
arrayMsg = arrayMsg & arrayToParse(i) & vbCrLf
Next i
Debug.Print "The array has parsed the following to the Colors table: " & vbCrLf & arrayMsg
rs.Close
Set rs = Nothing
Set db = Nothing
End Sub
You'll probably want to set myDelimStr to myDelimStr = getFileList("\\wwdata\dev\_commons\color","*.jpg") too.

How to List Field's Name in table in Access Using SQL

Can you please let me know if it is possible to list all fields name in a MS Access table?
I work in ms access far too much.
The only way I know of to do this, would be using vba, and defining for example a recordset, and looping through the fields.
Eg:
Sub ListFields()
dim rst as new adodb.recordset
rst.open "SELECT * FROM SomeTable", CurrentProject.Connection, adOpenForwardOnly, adLockReadOnly
' Note: adOpenForwardOnly and adLockReadOnly are the default values '
' for the CursorType and LockType arguments, so they are optional here '
' and are shown only for completeness '
dim ii as integer
dim ss as string
for ii = 0 to rst.fields.count - 1
ss = ss & "," & rst.fields(ii).name
next ii
Debug.Print ss
End Sub
The string variable ss will contain a comma-delimited list of all the column names in the table named "SomeTable".
With a little reformatting of the logic you should be able to insert this data into another table if you wanted to, then query it out.
Does this help?
This version is easy to run and will paste right into Access. Add this function to a module, run with F5, and copy the result from the inputbox:
Public Function FieldNames() As String
Dim sTable As String
Dim rs As DAO.Recordset
Dim n As Long
Dim sResult As String
sTable = InputBox("Name of table?")
If sTable = "" Then
Exit Function
End If
Set rs = CurrentDb.OpenRecordset(sTable)
With rs
For n = 0 To .Fields.Count - 1
sResult = sResult & .Fields(n).Name & vbCrLf
Next 'n
.Close
End With
Set rs = Nothing
InputBox "Result:" & vbCrLf & vbCrLf _
& "Copy this text (it looks jumbled, but it has one field on each line)", _
"FieldNames()", sResult
End Function
Alternative Output:
User user1003916 supplied an alternative to the InputBox to overcome the 1024 character limit (I have not tested this yet):
Sub CopyText(Text As String)
'VBA Macro using late binding to copy text to clipboard.
'By Justin Kay, 8/15/2014
Dim MSForms_DataObject As Object
Set MSForms_DataObject = CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
MSForms_DataObject.SetText Text
MSForms_DataObject.PutInClipboard
Set MSForms_DataObject = Nothing
End Sub
UPDATE: TO USE THIS SQL QUERY YOU MUST USE A TOOL SUCH AS DBEAVER.
ACCESS CLIENT WILL NOT ALLOW YOU TO QUERY IT'S HIDDEN STRUCTURES.
YIKES! IMO: I can't imagine wanting to dive into the dark underbelly of VBA
How to get Access Table Columns by SQL
SELECT * FROM information_schema.columns
WHERE TABLE_NAME="YOUR_TABLE_NAME"
AND
TABLE_SCHEMA="PUBLIC"
PS I noticed Access called my Schema "PUBLIC"
Above used an Access 2016 and was tested over ODBC and jdbc:ucanaccess and works like a charm.
Example output
You can simply use the Documenter tool. Go to Database Tools > Database Documenter, select the table and press OK.
This SQL works in Access 2016 for Queries, not Tables, but might be useful.
SELECT MSysObjects.Name AS QueryName,
IIf(IsNull([Name1]),
Right([Expression],Len([Expression])-InStr(1,[Expression],".")),[name1])
AS FieldName
FROM MSysQueries INNER JOIN MSysObjects
ON MSysQueries.ObjectId = MSysObjects.Id
WHERE MSysQueries.Attribute=6;
A quick and dirty method involves Excel. Do the following:
Open the table in Datasheet view.
Export to an Excel file, using the particular procedure for your Access version.
Open Excel file (if not already open).
Select and copy the first row containing the headers.
Add another sheet to the workbook (if none exist).
Click A1.
Paste Special > Transpose
The Fields will be pasted in a single column. To find out their Field Index number, in Cell B1 type "0", then series fill down to the last row of the field numbers.
In addition, you can sort the column alphabetically, especially for legacy flat files involving dozens of fields. This really saves a lot of time when I'm trying to convert a flatfile to a relational model.
There are already some good answers but I decided to add my own twist. Hopefully, they are self-explanatory.
Usage:
getFieldNames(TableName:="Table1",IncludeBrackets:=True,Delimiter:=vbNewLine,CopyToClipboard:=True)
getFieldNames(TableName:="Table1",IncludeBrackets:=True,CopyToClipboard:=True)
getFieldNames(TableName:="Table1",IncludeBrackets:=True)
getFieldNames(TableName:="Table1")
I use this to build an array of field names:
Chr(34) & getFieldNames(TableName:="Table1",IncludeBrackets:=False, Delimiter:= Chr(34) & "," & Chr(34)) & Chr(34)
Function getFieldNames(ByVal TableName As String, Optional ByVal IncludeBrackets As Boolean, Optional ByVal Delimiter As String = ", ", Optional ByVal CopyToClipboard As Boolean) As String
Dim rs As DAO.Recordset
On Error Resume Next
Set rs = CurrentDb.OpenRecordset(TableName)
On Error GoTo 0
If rs Is Nothing Then Exit Function
Dim results() As String
ReDim results(rs.Fields.Count - 1)
Dim n As Long
For n = 0 To rs.Fields.Count - 1
results(n) = rs.Fields(n).Name
Next
rs.Close
Dim result As String
If IncludeBrackets Then
result = "[" & Join(results, "]" & Delimiter & "[") & "]"
Else
result = Join(results, Delimiter)
End If
If CopyToClipboard Then
With CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
.SetText result
.PutInClipboard
End With
End If
getFieldNames = result
End Function
This is not SQL, but this question is the top Google result for someone like me who just needs to list out the field names needed for a query to select since Access does not support "* except foo, bar" for getting 99% of a table.
Answer adapted from a social.msdn.com answer by Patrick Wood, Access MVP
https://social.msdn.microsoft.com/Forums/office/en-US/1fe5546b-db3f-4e17-9bf8-04f4dee233b7/how-to-list-all-the-field-names-in-a-specified-table?forum=accessdev
Change tablename to your name in the module. This Function should be at the global level:
Function ListTdfFields()
' NOT doing DIMs, since then you must enable/attach ADODB or DAO
' Dim db As ADO.Database
Set db = CurrentDb
tablename = "tblProductLicense" ' <=== YOUR TABLE NAME HERE
Set tdf = db.TableDefs(tablename)
For Each fld In tdf.Fields
Debug.Print tablename; ".["; fld.Name; "]," ;
' remove ending ; for 1 line per field
Next
Debug.Print ""
Set tdf = Nothing
Set db = Nothing
End Function
Then add a macro RunCode ListTdfFields() and run it. Output will be sent to the Immediate window of the VBA design view for the module.
I would like to share this VBA solution, which I did not write, only slightly modified (changed the tableName to use 'SourceTable'). Once it is run you can query the table it creates. It takes advantage of hidden system tables.
Sub GetField2Description()
'************************************************* *********
'Purpose: 1) Deletes and recreates a table (tblFields)
' 2) Queries table MSysObjects to return names of
' all tables in the database
' 3) Populates tblFields
'Coded by: raskew
'Inputs: From debug window:
' Call GetField2Description
'Output: See tblFields
'************************************************* *********
Dim db As DAO.Database, td As TableDef
Dim rs As Recordset, rs2 As Recordset
Dim Test As String, NameHold As String
Dim typehold As String, SizeHold As String
Dim fielddescription As String, tName As String
Dim n As Long, i As Long
Dim fld As Field, strSQL As String
n = 0
Set db = CurrentDb
' Trap for any errors.
On Error Resume Next
tName = "tblFields"
'Does table "tblFields" exist? If true, delete it;
DoCmd.SetWarnings False
DoCmd.DeleteObject acTable, "tblFields"
DoCmd.SetWarnings True
'End If
'Create new tblTable
db.Execute "CREATE TABLE tblFields(Object TEXT (55), FieldName TEXT (55), FieldType TEXT (20), FieldSize Long, FieldAttributes Long, FldDescription TEXT (20));"
strSQL = "SELECT MSysObjects.Name, MSysObjects.Type From MsysObjects WHERE"
strSQL = strSQL + "((MSysObjects.Type)=1)"
strSQL = strSQL + "ORDER BY MSysObjects.Name;"
Set rs = db.OpenRecordset(strSQL)
If Not rs.BOF Then
' Get number of records in recordset
rs.MoveLast
n = rs.RecordCount
rs.MoveFirst
End If
Set rs2 = db.OpenRecordset("tblFields")
For i = 0 To n - 1
fielddescription = " "
Set td = db.TableDefs(i)
'Skip over any MSys objects
If Left(rs!Name, 4) <> "MSys" And Left(rs!Name, 1) <> "~" Then
NameHold = rs!Name
On Error Resume Next
For Each fld In td.Fields
tableName = fld.SourceTable
fielddescription = fld.Name
typehold = FieldType(fld.Type)
SizeHold = fld.Size
rs2.AddNew
rs2!Object = tableName
rs2!FieldName = fielddescription
rs2!FieldType = typehold
rs2!FieldSize = SizeHold
rs2!FieldAttributes = fld.Attributes
rs2!FldDescription = fld.Properties("description")
rs2.Update
Next fld
Resume Next
End If
rs.MoveNext
Next i
rs.Close
rs2.Close
db.Close
End Sub
Function FieldType(intType As Integer) As String
Select Case intType
Case dbBoolean
FieldType = "dbBoolean" '1
Case dbByte
FieldType = "dbByte" '2
Case dbInteger
FieldType = "dbInteger" '3
Case dbLong
FieldType = "dbLong" '4
Case dbCurrency
FieldType = "dbCurrency" '5
Case dbSingle
FieldType = "dbSingle" '6
Case dbDouble
FieldType = "dbDouble" '7
Case dbDate
FieldType = "dbDate" '8
Case dbBinary
FieldType = "dbBinary" '9
Case dbText
FieldType = "dbText" '10
Case dbLongBinary
FieldType = "dbLongBinary" '11
Case dbMemo
FieldType = "dbMemo" '12
Case dbGUID
FieldType = "dbGUID" '15
End Select
End Function
Build query:
SELECT Table_Name.*
FROM Table_Name
WHERE False;
Export to Excel
You will have each field name in one row without any data. If you select the row and copy, you can paste special>transpose and have them all in a single column.
I came here searching for the same requirement and after refering to this thread, drafted below code for my requirement. The Field names form the source table will be added to an array and later the Field names are assigned to the second table. Just sharing it here, this migh help someone later..
Public Sub FieldName_Change()
Dim intNumberOfFields, intX As Integer
Dim txtTableName,txttmpTableName txtFieldName() As String
intNumberOfFields = GetFieldNames(txtTableName, txtFieldName())
For intX = 1 To intNumberOfFields
CurrentDb.TableDefs(txttmpTableName).Fields("F" & intX).Name = txtFieldName(intX)
Next intX
End Sub
Public Function GetFieldNames(ByVal txtTableName As String, ByRef txtFiledName() As String) As Integer
Dim rs As DAO.Recordset
Dim n As Long
Dim sResult As String
Set rs = CurrentDb.OpenRecordset(txtTableName)
ReDim txtFiledName(rs.Fields.Count)
With rs
For n = 0 To .Fields.Count - 1
txtFiledName(n + 1) = .Fields(n).Name
Next n
.Close
GetFieldNames = n
End With
Set rs = Nothing
End Function
Not sure why no-one came up with the following, I had the same issue and none of the above answers either worked or were suitable (No VB,thank you).
This is simple Java (error checking etc omitted)
String query="SELECT TOP 1 * FROM mytable";
ResultSet rs=connectionSQL.createStatement().executeQuery(query);
ResultSetMetaData rsm=rs.getMetaData();
int colcount=rsm.getColumnCount();
for(int f=1; f<=colcount; f++) {
String coltype=rsm.getColumnTypeName(f);
String colname=rsm.getColumnName(f);
.... (whatever)
}
So there's your columNames and the data types.
Works like a charm in MSACCESS
Seems like this task was easier in older days. Likely this answer is highly version-dependent. It works for me in a quick test against an Access 2007 DB:
select
Specs.SpecName AS TableName,
Columns.FieldName
from
MSysIMEXColumns Columns
inner join MSysIMEXSpecs Specs on Specs.SpecID = Columns.SpecID
order by
Specs.SpecName,
Columns.FieldName
Give this a go...
private void Button_OldDDLDump_Click(object sender, EventArgs e)
{
string _cnstr = "connectionstringhere";
OleDbConnection _cn = new OleDbConnection(_cnstr);
try
{
_cn.Open();
System.Data.DataTable _dt = null;
try
{
_dt = _cn.GetSchema("tables");
m_msghelper.AppendArray( DataTableHelper.DataTableToString(_dt) );
}
catch (Exception _ex)
{
System.Diagnostics.Debug.WriteLine(_ex.ToString());
}
finally
{
_dt.Dispose();
}
}
catch (Exception _ex)
{
System.Diagnostics.Debug.WriteLine(_ex.ToString());
}
finally
{
_cn.Close();
}
}
Helper method to dump the database structure to a string array here..
public static class DataTableHelper
{
public static string[] DataTableToString( System.Data.DataTable dt )
{
List<string> _retval = new List<string>();
foreach (System.Data.DataRow row in dt.Rows)
{
foreach (System.Data.DataColumn col in dt.Columns)
{
_retval.Add( string.Format("{0} = {1}", col.ColumnName, row[col]) );
}
_retval.Add( "============================");
}
return _retval.ToArray();
}
}
select column_name from information_schema.columns where table_name='table'