My Code is:
Public Sub ImportCommonFields()
Set rs1 = CurrentDb.OpenRecordset("Imported Table" & " " & TableCtr)
Set cf = CurrentDb.OpenRecordset("CommonFields")
cf.AddNew
cf("FieldNames") = rs1.Fields
cf.Update
Set fld = Nothing
End Sub
I am currently getting the column names (Fields) from the table in rs1 and would like to import them to an existing table "CommonFields" under the column "FieldNames".
Loop the Fields collection:
Public Sub ImportCommonFields()
Dim fld As DAO.Field
Set rs1 = CurrentDb.OpenRecordset("Imported Table" & " " & TableCtr)
Set cf = CurrentDb.OpenRecordset("CommonFields")
For Each fld In rs1.Fields
cf.AddNew
cf("FieldNames").Value = fld.Name
cf.Update
Next
cf.Close
rs1.Close
Set fld = Nothing
End Sub
Related
I have created and manipulated an external database from the existing tables in my current database.
The matter is that I necessarily have to manipulate "Description" property in the new database fields.
When I try to retrieve "Description" property from cereated external database, response is that "Description" isn't a property (Error 3270, "property not found")
How could I do it?
I tried the following code:
Sub Actualizacomentarios()
Dim dbFinal As DAO.Database
Dim tbl As DAO.TableDef
Dim fld As DAO.Field
Dim tblFinal As DAO.TableDef
Dim fldFinal As DAO.Field
Dim prpFinal As DAO.Property
Set dbFinal = DBEngine.OpenDatabase("D:\Dropbox\Expedientes JLE nueva epoca activos\17002 - Fermin Torres. Programa\NuevoFoasat.accdb")
For Each tbl In CurrentDb.TableDefs
If InStr(tbl.Name, "JLE_") > 0 Then
For Each fld In tbl.Fields
Set tblFinal = dbFinal.TableDefs(tbl.Name)
Set fldFinal = tblFinal.Fields(fld.Name)
fldFinal.Properties("Description") = fld.Properties("Description") 'HERE OCCURS ERROR
Next fld
End If
Next tbl
dbFinal.Close
Set dbFinal = Nothing
Rewritten and working . Thanks to #HansUp
Sub Actualizacomentarios()
Dim dbFinal As DAO.Database
Dim tbl As DAO.TableDef
Dim fld As DAO.Field
Dim tblFinal As DAO.TableDef
Dim fldFinal As DAO.Field
Dim prpFinal As DAO.Property
Set dbFinal = DBEngine.OpenDatabase("D:\Dropbox\Expedientes JLE nueva epoca activos\17002 - Fermin Torres. Programa\NuevoFoasat.accdb")
For Each tbl In CurrentDb.TableDefs
If InStr(tbl.Name, "JLE_") > 0 Then
For Each fld In tbl.Fields
Set tblFinal = dbFinal.TableDefs(tbl.Name)
Set fldFinal = tblFinal.Fields(fld.Name)
On Error GoTo ErrorTrap
If Nz(fld.Properties("Description"), "") <> "" Then
Set prpFinal = fldFinal.CreateProperty("Description")
prpFinal.Type = dbText
prpFinal.Value = fld.Properties("Description")
fldFinal.Properties.Append prpFinal
'Debug.Print fldFinal.Name, fldFinal.Properties("Description")
fldFinal.Properties("Description") = fld.Properties("Description")
End If
On Error GoTo 0
Next fld
End If
Next tbl
dbFinal.Close
Set dbFinal = Nothing
Exit Sub
ErrorTrap:
If Err.Number = 3367 Then
Debug.Print "Property already exists on " & tbl.Name & " (Field: " & fld.Name & ")"
Else
Stop
Debug.Print "Not Found or empty on " & tbl.Name & " (Field: " & fld.Name & ")"
End If
Resume Next
End Sub
I have a first table called "BreedingTable" with primary key "ID" and "TransactionStatus" = "Active".
I have "Kidding form" data populated from the combo box to Text fields
Text2.value = "ID" from BreedingTable.
When I am done with all the process, I want to change TransactionStatus of Breeding table = Closed.
I am using the below code but it never works.
Note" if I give exact transaction id number it works fine,
but if I ask to find based on text2 it doesn't work.
My code is as follows:
Private Sub exitprograme3()
Me.Text2.SetFocus
Dim i As Integer
Dim db As Database
Dim rs As Recordset
Dim Trn As Integer
Set db = CurrentDb
Set rs = db.OpenRecordset("BreedingTable")
For i = 0 To rs.RecordCount - 1
Me.Text2.SetFocus
If rs.Fields("ID") = Me.Text2.Value Then
rs.Edit
rs.Fields("BreedingStatus") = "Closed"
rs.Update
End If
rs.MoveNext
Next i
rs.Close
Set rs = Nothing
db.Close
DoCmd.Close
End Sub
Please assist ...
If I type exact transaction id number in below if statement it works
If rs.Fields("ID") = "323" Then
this works fine.
But if I type like below it doesn't work
If rs.Fields("ID") = Me.Text2.Value Then
No loop is needed:
Private Sub exitprograme3()
Dim db As DAO.Database
Dim rs As DAO.Recordset
Set db = CurrentDb
Set rs = db.OpenRecordset("Select * From BreedingTable")
rs.FindFirst "[ID] = " & Me!Text2.Value & ""
' If ID is text, then quotes:
' rs.FindFirst "[ID] = '" & Me!Text2.Value & "'"
If Not rs.NoMatch Then
rs.Edit
rs.Fields("BreedingStatus").Value = "Closed"
rs.Update
End If
rs.Close
Set rs = Nothing
Set db = Nothing
DoCmd.Close
End Sub
In Access 2007 I need to select all the short-text fields in a table.
VBA code should look like this:
Dim strClient As String
Set dbs = CurrentDb()
Debug.Print Me.ID
strClient = "Select * from ANG_CLIENTS where DATA_TYPE='TEXT' AND ID=" & Me.ID
Set rs = dbs.OpenRecordset(strClient)
I get "Runtime error 3061. Too few parameters. Expected 1" on the last assignment.
You need to define a custom function to loop through the recordset fields and extract the names of text fields only.
The names can then be added to your SQL script.
Public Function TextDataFileds(rs As DAO.Recordset) As String
Dim fld As DAO.Field, item As String
For Each fld In rs.Fields
If fld.Type = 10 Then 'dbText
item = IIf(Len(item) = 0, fld.Name, item & ", " & fld.Name)
End If
Next fld
TextDataFileds = item
End Function
You can then call it like this:
Sub Test()
On Error GoTo ErrProc
Dim rs As DAO.Recordset
Set rs = CurrentDb().OpenRecordset("SELECT TOP 1 * FROM ANG_CLIENTS;")
Dim sql_ As String
sql_ = "SELECT " & TextDataFileds(rs) & " FROM ANG_CLIENTS WHERE ID=" & Me!ID
rs.Close
Set rs = Nothing
Set rs = CurrentDb().OpenRecordset(sql_)
'....
Leave:
rs.Close
Set rs = Nothing
On Error GoTo 0
Exit Sub
ErrProc:
MsgBox Err.Description, vbCritical
Resume Leave
End Sub
I have looked and looked for an answer and cannot translate the answers to my specific code. I have some code for an Access Database that works as an INSERT TO but I want it to UPDATE a table. I cannot get it to run after changing it to UPDATE.
The following code works and what it does is add values that meet the criteria to the beginning of an existing table. But I want it to update the existing blank column "O_StateRegion" in a table called "Sonoco2016_xlsx". My efforts of switching INSERT INTO to UPDATE have failed. (See second example of code for my efforts)
Private Sub InsertStateRegion()
On Error GoTo InsertRegions_Err
Dim db As Database
Dim rs As Recordset
Dim strSQL As String
Set db = CurrentDb
Set rs = db.OpenRecordset("Select [OriginState] from [Sonoco2016_xlsx];")
rs.MoveFirst
While Not rs.EOF
strSQL = "UPDATE [Sonoco2016_xlsx] ([O_StateRegion])"
strSQL = strSQL & " SELECT [StateRegion] FROM [tblStates]"
strSQL = strSQL & " WHERE [tblStates].[StateAbbrev]='" & rs![OriginState] & "' "
db.Execute (strSQL), dbFailOnError
rs.MoveNext
Wend
rs.Close
Set rs = Nothing
Set db = Nothing
btnInsertRegions_Exit:
Exit Sub
InsertRegions_Err:
MsgBox Err.Description & " in btnInsertRegions"
Resume btnInsertRegions_Exit
End Sub
Below are my efforts to convert it to UPDATE
Private Sub btnInsertRegions_Click()
On Error GoTo InsertRegions_Err
Dim db As Database
Dim rs As Recordset
Dim strSQL As String
Set db = CurrentDb
Set rs = db.OpenRecordset("Select [OriginState] from [Sonoco2016_xlsx];")
rs.MoveFirst
While Not rs.EOF
strSQL = "UPDATE [Sonoco2016_xlsx] ([O_StateRegion])"
strSQL = strSQL & " SET [Sonoco2016_xlsx].[O_StateRegion]=[tblStates].[StateRegion]"
strSQL = strSQL & " WHERE [tblStates].[StateAbbrev] = '" & rs![OriginState] & "' "
db.Execute (strSQL), dbFailOnError
rs.MoveNext
Wend
rs.Close
Set rs = Nothing
Set db = Nothing
btnInsertRegions_Exit:
Exit Sub
InsertRegions_Err:
MsgBox Err.Description & " in btnInsertRegions"
Resume btnInsertRegions_Exit
End Sub
The correct syntax for what you want to achieve is
UPDATE [Sonoco2016_xlsx]
INNER JOIN [tblStates]
ON [tblStates].[StateAbbrev] = [Sonoco2016_xlsx].[OriginState]
SET [Sonoco2016_xlsx].[O_StateRegion]=[tblStates].[StateRegion];
which you would execute without using a recordset.
Note, however, that this will only work if [StateAbbrev] has a unique index, e.g. if it is the primary key of [tblStates]. Otherwise, the update would be ambiguous.
Moreover, it is not possible to use a subquery in the set statement like
SET [Sonoco2016_xlsx].[O_StateRegion]=(SELECT [StateRegion]
FROM = [tblStates]
WHERE [StateAbbrev] = rs![OriginState])
because subqueries are prohibited in UPDATE statements.
Here is the answer that worked for me thanks to M Doerner!
Private Sub btnInsertRegions_Click()
On Error GoTo InsertRegions_Err
Dim db As Database
Dim rs As Recordset
Dim strSQL As String
Set db = CurrentDb
Set rs = db.OpenRecordset("Select [OriginState] from [Sonoco2016_xlsx];")
rs.MoveFirst
While Not rs.EOF
strSQL = "UPDATE [Sonoco2016_xlsx] INNER JOIN [tblStates]"
strSQL = strSQL & " ON [tblStates].[StateAbbrev] = [Sonoco2016_xlsx].[OriginState]"
strSQL = strSQL & " SET [Sonoco2016_xlsx].[O_StateRegion]=[tblStates].[StateRegion]"
db.Execute (strSQL), dbFailOnError
rs.MoveNext
Wend
rs.Close
Set rs = Nothing
Set db = Nothing
btnInsertRegions_Exit:
Exit Sub
InsertRegions_Err:
MsgBox Err.Description & " in btnInsertRegions"
Resume btnInsertRegions_Exit
End Sub
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