using vba to change field name in access 2007 - ms-access

I receive data monthly from an external company and need to change the field name to a sequential number. example contract 11 15 17 to 1 2 3. I am trying to use the following code but get an error that I cannot define the field more than once at "fld.Name = (n) + 1". How can I correct this?
Function ChangeFieldName()
Dim db As DAO.Database
Dim tbl As DAO.TableDef
Dim fld As DAO.Field
Dim n As Integer
Set db = CurrentDb
Set tbl = db.TableDefs("tdf1")
On Error Resume Next
n = 0
For Each fld In tbl.Fields
fld.Name = (n) + 1
Next fld
Set fld = Nothing
Set tbl = Nothing
Set db = Nothing
End Function

That code attempts to rename each field to n + 1, but since n is never incremented, it actually attempts to rename every field to 1. The following change may do what you want.
n = 1
For Each fld In tbl.Fields
fld.Name = n
n = n + 1
Next fld
However there are some other issues you should consider with that approach. The For Each loops through the fields based on fld.OrdinalPosition. If your numbered field names were not defined in the order you expect, you will have a problem. For example, these fields in OrdinalPostion order: 11; 15; 2. In that case 11 would be renamed to 1, but the code would throw an error when attempting to rename 15 to 2.
Also that code will attempt to rename every field to a number. If the table only contains numbered field names, that may not be a problem. But if the table also contains other field names you wish to preserve, you've got more work to do.
A minor point is that fld.Name is text type. When you attempt to rename a field to a number, Access actually uses the number's string equivalent. That may be fine, but I would prefer to explicitly cast the number to a string myself.
fld.Name = CStr(n)
Finally please reconsider this ...
On Error Resume Next
That instructs Access to silently ignore all errors. I think you should get rid of that and add a proper error handler code block instead.

Related

Transpose a table in Access using VB code

I have a table that is populated with data from a delimited text file. The data comes from another system and I cannot modify how it is generated into the text file I am importing. Once the data is imported into access, it is not in a normalized fashion. The first two columns of data are date ranges, the third is a location code, the remaining 54 columns hold specific data for each location. I need to find the top five values for each record so I can put them into a report.
I had posed this question in another thread, but was unable to find a solution. In that thread, someone recommended that I used a union query. It appeared that it was going to work perfectly, but you can only use 50 unions in access and I have to many fields.
Now I am trying to use VB code in access to transpose the table. I am working with the following code that I retrieved from this page. It is throwing an error on execution. I cannot figure out what the issue is. I know it is a syntax error or creating the object, but I have tried everything I can think of and cannot get it to work. Also, The column headers would contain string info so I was going to change the variable to a variant instead of an integer? Any help with this code, or suggestions regarding how to get what I want from the table would be appreciated.
Picture of actual table.
I am getting a error -> 'Run-time error '3265': Item not found in this collection.
Private Sub Command78_Click()
Const cstrInputTable = "Base Period OT"
Const cstrOutputTable As String = "Normalized Base Period OT"
Dim dbs As DAO.Database
Dim rstInput As DAO.Recordset
Dim rstOutput As DAO.Recordset
Dim intYear As Integer
Set dbs = CurrentDb
Set rstInput = dbs.OpenRecordset(cstrInputTable)
Set rstOutput = dbs.OpenRecordset(cstrOutputTable)
If Not rstInput.EOF Then
' For each column in the Input table, create a record in the output table
For intYear = 1990 To 2011
rstInput.MoveFirst
rstOutput.AddNew
rstOutput![Year] = intYear
' Go through every record in the Input table
Do
rstOutput(rstInput![Data Type]) = rstInput(CStr(intYear))
rstInput.MoveNext
Loop Until rstInput.EOF
rstOutput.Update
Next intYear
End If
rstInput.Close
rstOutput.Close
dbs.Close
MsgBox "Data Successfully Transformed"
DoCmd.OpenTable cstrOutputTable
End Sub
Still not sure I have fully understood your inputs and outputs. I'll give it a try though and you let me know if I'm even close to what you're looking for.
You can create a "Temp" table with only 3 fields just for sorting purposes. You can then loop through your source table and add Location, Column header (3 letter code) and the value of each field to the "Temp" table.
You can then sort by value DESC and select the top 5.
Public Sub GetTopFive()
On Error GoTo ErrProc
Dim rs As DAO.Recordset
Set rs = CurrentDb.OpenRecordset("SELECT Location, AMR, AXT, BRM, BMM, CSR, CTC " & _
"FROM DataSource ORDER BY Location;", dbOpenSnapshot)
If rs.EOF Then GoTo Leave
With rs
.MoveLast
.MoveFirst
End With
Dim idx As Long
For idx = 1 To rs.RecordCount
AddToTempTable rs
'Now the Temp table holds one Location, sorted by value
'Selecting the top 5 records will give you what you're looking for
'If that's the case, provide additional info on how to handle this
'as each location might have different field names.
rs.MoveNext
Next idx
Leave:
On Error Resume Next
rs.Close
Set rs = Nothing
On Error GoTo 0
Exit Sub
ErrProc:
MsgBox Err.Description, vbCritical
Resume Leave
End Sub
'Add To Temp for sorting
Private Sub AddToTempTable(rs As DAO.Recordset)
Dim fld As DAO.Field
For Each fld In rs.Fields
If fld.Name <> "Location" Then
With CurrentDb.QueryDefs("qryAddToTemp")
.Parameters("[prmLocation]").Value = rs!Location
.Parameters("[prmFileldName]").Value = fld.Name
.Parameters("[prmFieldValue]").Value = fld.Value
.Execute dbFailOnError
End With
End If
Next fld
End Sub
Import query
PARAMETERS [prmLocation] Text ( 255 ), [prmFileldName] Text ( 255 ), [prmFieldValue] IEEESingle;
INSERT INTO tbTemp ( Location, [Field Name], [Field Value] )
SELECT [prmLocation] AS Location, [prmFileldName] AS [Field Name], [prmFieldValue] AS [Field Value];
Temp Table
Update:
Public Sub GetTopFive()
On Error GoTo ErrProc
Dim rs As DAO.Recordset
Set rs = CurrentDb.OpenRecordset("SELECT Location, AMR, AXT, BRM, BMM, CSR, CTC " & _
"FROM DataSource ORDER BY Location;", dbOpenSnapshot)
If rs.EOF Then GoTo Leave
With rs
.MoveLast
.MoveFirst
End With
Dim rsTemp As DAO.Recordset, fld As DAO.Field, idx As Long
Set rsTemp = CurrentDb.OpenRecordset("tbTemp")
With rsTemp
For idx = 1 To rs.RecordCount
For Each fld In rs.Fields
If fld.Name <> "Location" Then
.AddNew
.Fields("YourCodeColumnName").Value = fld.Name
.Fields(rs!Location).Value = fld.Value
.Update
End If
Next fld
rs.MoveNext
Next idx
End With
Leave:
On Error Resume Next
rsTemp.Close
Set rsTemp = Nothing
rs.Close
Set rs = Nothing
On Error GoTo 0
Exit Sub
ErrProc:
MsgBox Err.Description, vbCritical
Resume Leave
End Sub
Based on what you have provided there are 6 possibilities of where you are getting error 3265, and 4 of them have the same solution, once you understand how DAO Recordset objects work and reference fields in the "Table" they represent.
The error Item not found in this collection, given the code you have presented indicates that you are referencing a field name (column name) in the recordset that does not exist. Or, that you are referencing a table name that does not exist in the database.
Since your code is dynamically determining field names, and you haven't provided the structure of the tables Base Period OT or Normalized Base Period OT, you will have to figure part of this out on your own.
Here are the 4 places where the error could be occurring for the Recordset objects and what you are looking for:
rstOutput![Year] = intYear, you are telling Access that you expect a column named "Year" to exist in your table Normalized Base Period OT and that you want to insert the current value of intYear into that column. If "Year" is not a column name in that table, this would be the problem.
3, & 4. rstOutput(rstInput![Data Type]) = rstInput(CStr(intYear)) In this single line of code, you have 3 possible locations for the error.
a. rstInput![Data Type] Does the table Base Period OT contain a column named "Data Type"? If not, this would be an error. Here you are statically providing the name of the column that you expect to exist in the input table.
b. rstOutput(rstInput![Data Type]) Assuming that rstInput![Data Type] is a valid column, the value in that column is now the name of the column you are expecting to exist in Normalized Base Period OT. If that is not true, this would be an error. Here, you are dynamically providing the name of the column that you expect to exist in the output table.
c. rstInput(CStr(intYear)) Does the table Base Period OT contain a column for the current value of intYear (i.e. does that table contain columns named 1990, 1991, 1992, etc through 2011 as defined in your loop?) If not, this would be an error. Here, again, you are dynamically providing the name of the column that you expect to exist in the input table.
5 & 6. You could also receive this error on your OpenRecordset commands if the tables, named in your two constants don't exist.
This addresses the issue with your code sample, but does not address whether your approach to transform the data for your other stated purposes is correct or not as we do not have enough additional information.

Inserting records in MS Access by means of macros

Good evening!
At this moment I'm learning to work in MS Access for my job purposes. I gained some understanding of the program's basics, such as creating tables or making easy forms (though not yet working ideally), and by now I've got stuck in solving the following task.
I have a database BooksDatabase, which consists of three tables: Books, Authors and AuthorsInfo. First one contains information about books (name, genre, country, release year etc.), third one is about authors (first name, last name etc.) and the second one links ever book with its author(s). The task is to import data from text file to those tables, so that it would be almost automatic. I understand how to import files to MS Access (at least, the ones of *.txt extension) and I do this into the table BooksToImport, but I have some difficulties with inserting imported data. Here is the code of my function ImportBooks(), which I execute from macros of the same name:
' Procedure which imports data about books from the table BooksToImport
Function ImportBooks()
Dim dbBooks As Database
Dim rstImBooks, rstBooks, rstAuthors, rstBALink As DAO.Recordset
Dim codeI, codeB, codeA, codeL As Variant
'initializing database
Set dbBooks = CurrentDb
Set rstImBooks = dbBooks.OpenRecordset("Query_BooksToImport",dbOpenDynaset) 'receiving data from query
'checking if the query has any records
If rstImBooks.RecordCount = 0 Then
MsgBox "There are no records for importing!", vbInformation, "Attention!"
rstImBooks.Close
Set dbBooks = Nothing
Exit Function
End If
'if it's OK, we're making a loop on query's records
rstBooks = dbBooks.OpenRecordset("Books",dbOpenDynaset)
rstAuthors = dbBooks.OpenRecordset("AuthorsInfo",dbOpenDynaset)
rstBALink = dbBoks.OpenRecordset("Authors",dbOpenDynaset)
rstImBooks.MoveLast
rstImBooks.MoveFirst
Do While rstImBooks.EOF = False
'checking if there is a book in out database with the same name as in imported data
codeB = DLookup("[ID]","[Books]","[BookName] = '" & rstImBooks![BookName] & "'")
If IsNull(codeB) Then
'inserting new record
With rstBooks
.AddNew
![BookName] = rstImBooks![BookName]
.Update
.Bookmark = .LastModified
codeB = ![ID]
End With
End If
'in much the same way we're treating the data about authors and making the links
rstImBooks.MoveNext
Loop
rstImBooks.Close
rstBooks.Close
rstAuthors.Close
rstBALink.Close
Set dbBooks = Nothing
End Function
I have two problems with this function:
method .AddNew for rstBooks is not working — MS Access shows me a message with error 438 ("Object doesn't support this property or method");
also I cannot assign variable rstBALink to the recordset because compiler says "Invalid use of property".
So my question is this: how should I solve these two problems? What do I do wrong that my function is not working properly?
A few issues with your code that I see. These may or may not fix your problem.
Your declarations are implicit, meaning you aren't being specific with your code about what your recordset objects are. Instead of using:
Dim rstImBooks, rstBooks, rstAuthors, rstBALink As DAO.Recordset
Try:
Dim rstImBooks As DAO.Recordset
Dim rstBooks As DAO.Recordset
Dim rstAuthors As DAO.Recordset
Dim rstBALink As DAO.Recordset
You can put them all on one line separated by commas, but you still need to declare the type for each or Access will assume it's a variant.
Secondly, recordset objects need to be created using the Set keyword, not by using an = alone.
This was done correctly in the top portion of your code, but is incorrect here:
rstBooks = dbBooks.OpenRecordset("Books",dbOpenDynaset)
rstAuthors = dbBooks.OpenRecordset("AuthorsInfo",dbOpenDynaset)
rstBALink = dbBoks.OpenRecordset("Authors",dbOpenDynaset)
Should be:
Set rstBooks = dbBooks.OpenRecordset("Books",dbOpenDynaset)
Set rstAuthors = dbBooks.OpenRecordset("AuthorsInfo",dbOpenDynaset)
Set rstBALink = dbBooks.OpenRecordset("Authors",dbOpenDynaset)
I think that will solve your issues, but I didn't review every line of your code admittedly. Let me know if you still have problems.
EDIT:
Found a typo:
rstBALink = dbBoks.OpenRecordset("Authors",dbOpenDynaset)
Should be:
Set rstBALink = dbBooks.OpenRecordset("Authors",dbOpenDynaset)
(missed an 'o' in dbBooks)

Invalid field Data type when use TableDef.CreateField Method VBA [duplicate]

This question already has answers here:
How do I create a decimal field in Access with Alter Table?
(3 answers)
Closed 6 years ago.
I am attempting to add a series of fields to a Access 2016 Table, but keep encountering the error:
Runtime error '3259'
Invalid field data type
I originally specified the data type as dbNumeric but changed it to dbDecimal to see if that made a difference. The solution given here for CreateFields did not solve my problem, though I did not try the SQL. It did not. Here is the code:
Sub BOD_Variables()
Dim myDBS
Dim myTable As TableDef
Dim myTableName As String
myTableName = "BOD_Data"
Set myDBS = CurrentDb
Set myTable = myDBS.TableDefs(myTableName)
Dim myField As Field
Dim myVariableNames As Variant
myVariableNames = Array("Blank_4_SampleVol", ... "BOD_ Concentration _OUT")
Dim iCount As Integer
For iCount = LBound(myVariableNames) To UBound(myVariableNames)
Debug.Print myVariableNames(iCount)
Set myField = myTable.CreateField(myVariableNames(iCount), dbDecimal) 'Originally specified dbNumeric for data type.
myTable.Fields.Append myField
Next
End Sub
I attempted to replace the call to the Array(index) with:
Set myField = myTable.CreateField("Blank_4_SampleVol", dbNumeric)
Still get the same error.
I tried specifying the length as discussed here, but that did not correct problem. Documentation on CreateField says it ignores field length when field type is dbNumberic.
Any ideas of what I am missing? Thanks in advance.
While it remains true that DAO does not seem to expose the required properties to create a Decimal field, even if we try using a DAO.Field2 object, the following ADOX code does create a Decimal field (tested with Access 2010):
Option Compare Database
Option Explicit
Sub AddNewDecimalField()
Dim cat As New ADOX.Catalog
cat.ActiveConnection = CurrentProject.Connection
Dim tbl As ADOX.Table
Set tbl = cat.Tables("MyTable")
Dim col As New ADOX.Column
col.Name = "MyNewDecimalField"
col.Type = adNumeric ' note: not adDecimal
col.Precision = 18
col.NumericScale = 8
tbl.Columns.Append col
End Sub
Or, we could just use a DDL query ...
CurrentProject.Connection.Execute _
"ALTER TABLE MyTable ADD COLUMN MyNewDecimalField DECIMAL(18,8)"
... as Andre suggests in his answer.
Follow the link in your linked question, and read the footnote #7 for DECIMAL:
[7] Not available in the Access query interface or DAO. Use ADO to Execute the DDL query statement.
So you'd use something like this:
strSQL = "ALTER TABLE myTable ADD COLUMN " & myVariableNames(iCount) & " DECIMAL (20,6);"
CurrentProject.Connection.Execute strSQL
Decimal fields have had (see comment below) their issues, see Avoid Using Decimal Field Size in Microsoft Access Tables
or http://allenbrowne.com/bug-08.html
Long or Double or Currency may be better options.

MS Access 2013 Web App - Create unique value for field between 0 and 9999

I have a table where I need the field "DirNum" to be a unique number between 0 and 9999. In addition, the user needs to be able to manually assign a "random" unique number to this field as long as it is between 0 and 9999 (such as the number 8000).
Since its not feasible to expect my user to guess unique numbers every time, I would like to have the ability to create this number for them. I'm pretty open as to how I should do this.
So what I have considered:
Make the default value this unique number
Make a control button
that inserts this unique number
Make the "New" control button
insert this new record
Problem is, I don't really know how to go about doing this.
I would assume the best way to do this would be to query all the existing values for "DirNum" and assign the lowest value to the new record. But I don't even know where to start when coding this.
You could make a function in vba to do this. This will return the next available id or 0 if none are available. The 9999 sets the upper limit.
Public Function getNextAvailableID() As Integer
Dim rst As DAO.Recordset
Set rst = CurrentDb.OpenRecordset("Select ID From TestUniqueNumber order by id", dbOpenSnapshot)
Dim intLastID As Integer
Dim intNextAvailableID As Integer
intLastID = 0
With rst
.MoveFirst
Do Until .EOF Or intLastID = 9999
If rst!ID - intLastID > 1 Then
intNextAvailableID = intLastID + 1
Exit Do
End If
intLastID = rst!ID
.MoveNext
Loop
End With
getNextAvailableID = intNextAvailableID
End Function
If you had many more rows than 9999 and vba was too slow, you could look into an SQL statement to handle this.

Round Robin Records in Access VBA

I am attempting to round-robin names into a "TASK" column depending on which type of job is assigned in the "JOB" column. My table looks like this for example:
my code is as follows:
Sub macro2()
Dim Rst As DAO.Recordset
Set Rst = CurrentDb.OpenRecordset("table1")
Dim employee(2) As String
employee(0) = "empname1"
employee(1) = "empname2"
Dim i As Integer
With Rst
i = 0
Rst.MoveFirst
Do While Not .EOF
If Rst.Fields("JOB") = "LETTER" Then
Rst.Edit
Rst.Fields("Task").value = employee(i)
Rst.Update
End If
.MoveNext
i = i + 1
If i > 2 Then i = 0
Loop
End With
DoCmd.Requery
End Sub
The problem is, sometimes it "misses" an assignment, and I am not sure why.
It should have kept looping those 2 names into the column, but it wont. However, sometimes after running it a couple of times it will do it. Upon opening the DB fresh, it will not, and will appear as above after completing. Any ideas?
This piece of the code allows i to have a value of 2.
i = i + 1
If i > 2 Then i = 0
But UBound(employee) is 1, which means employee(i) should throw a "subscript out of range" error when i is 2. But you didn't report getting that error, so I don't understand what's going on.
Also your first screenshot shows "Letter" and "Change" in the Job column, but the second screenshot shows all as "Letter". That's another puzzler.
Maybe you need to load the recordset with a query rather than the full table.
Set Rst = CurrentDb.OpenRecordset("SELECT Job, Task FROM table1 " & _
"WHERE Job = 'Letter'")
Then as you move through the recordset rows, toggle i between 0 and 1.
i = IIf(i = 1, 0, 1)
It looks to me like those changes might allow your code to work as you intend. However consider an approach which is more flexible and easier to maintain. Store the employee names in a table and open a second recordset, rsEmployees, to hold those employee names. As you move through the first recordset, Rst, also advance the second: rsEmployees.MoveNext If you reach rsEmployees.EOF, do rsEmployees.MoveFirst That should "round robin" the assignments.
That approach would allow you to add/remove employees from the available pool by simply updating the employees table. You wouldn't need to revise your VBA code each time you add/remove employees.