All,
I'm trying to save a record for 1 record to a drive. I've spent about a day searching for a solution so this is a last ditch effort for some help. I am not a developer by any stretch of the imagination so please, go easy.
Code is below.
Table where record is located: tracker.
Field I am searching based on: ReqID - where ReqID = the record I am entering, find the attachment and move it to a location.
Dim db As DAO.Database
Dim rsChild As DAO.Recordset2
Dim ReqID As String
ReqID = Me.Form![Text145]
Debug.Print ReqID
Set db = CurrentDb
Set rsChild = db.OpenRecordset("Select * from tracker Where " & ReqID & " = [tracker].[ID]", dbOpenDynaset)
Debug.Print rsChild.RecordCount
If (rsChild.EOF = False) Or (rsChild.BOF = False) Then
While Not rsChild.EOF
rsChild("FileData").SaveToFile "C:\Users\<folder>\"
rsChild.Delete
Wend
End If
You actually need to use two Recordset objects: one for the main record and another for the attachment(s) associated with that record. This is the sample code that works for me, where [tblTest] is the name of the table and [Attachments] is the name of the Attachment field:
Option Compare Database
Option Explicit
Sub SaveAllAttachments()
Dim cdb As DAO.Database
Set cdb = CurrentDb
Dim rstMain As DAO.Recordset
Set rstMain = cdb.OpenRecordset("SELECT Attachments FROM tblTest WHERE ID=1", dbOpenDynaset)
rstMain.Edit
Dim rstChild As DAO.Recordset2
Set rstChild = rstMain.Fields("Attachments").Value
Do Until rstChild.EOF
Dim fileName As String
fileName = rstChild.Fields("FileName").Value
Debug.Print fileName
Dim fld As DAO.Field2
Set fld = rstChild.Fields("FileData")
fld.SaveToFile "C:\Users\Gord\Desktop\" & fileName
rstChild.Delete ' remove the attachment
rstChild.MoveNext
Loop
rstChild.Close
rstMain.Update
rstMain.Close
End Sub
Related
Private Sub Command15_Click()
On Error Resume Next
Dim db As Database
Dim RST As Variant
Set db = CurrentDb
Set RST = db.OpenRecordset("SSPTab")
With RST
.Edit
.Fields(6) = Me.Reviewersname
.Fields(9) = Me.Assessments
.Fields(11) = Me.Review_Comments
.Fields(7) = Me.Reviewstatus
.Update
End With
I would like to open the existing row details and make changes to it and update. The above code is working fine for me except .Fields(7) , showing data conversion error.
Use proper declarations:
Private Sub Command15_Click()
Dim db As DAO.Database
Dim rst As DAO.Recordset
Set db = CurrentDb
Set rst = db.OpenRecordset("SSPTab")
With rst
.Edit
.Fields(6).Value = Me!Reviewersname.Value
.Fields(9).Value = Me!Assessments.Value
.Fields(11).Value = Me!Review_Comments.Value
' Field 7 must be Short Text or Long Text.
' .Fields(7).Value = Me!Reviewstatus.Value
.Fields(7).Value = Me!Revstats.Value
.Update
.Close
End With
End Sub
I have looked at this post: Saving changes to a multivalued ComboBox via AuditTrail
And tried to take tidbits and put it into my code, but it just didn't work! I am not really great at SQL but I need to get this done. Here is my code and it works for textboxes, but can someone tell me exactly where and exactly what to put what I need for my combobox dropdown list changes?
Thanks in advance!!
Function LogChanges(lngID As Long, Optional strField As String = "")
Dim dbs As DAO.Database
Dim rst As DAO.Recordset
Dim varOld As Variant
Dim varNew As Variant
Dim strFormName As String
Dim strControlName As String
varOld = Screen.ActiveControl.OldValue
varNew = Screen.ActiveControl.Value
strFormName = Screen.ActiveForm.NAME
strControlName = Screen.ActiveControl.NAME
Set dbs = CurrentDb()
Set rst = dbs.TableDefs("ztblDataChanges").OpenRecordset
With rst
.AddNew
!FormName = strFormName
!ControlName = strControlName
If strField = "" Then
!FieldName = strControlName
Else
!FieldName = strField
End If
!RecordID = lngID
!UserName = Environ("username")
If Not IsNull(varOld) Then
!OldValue = CStr(varOld)
End If
!NewValue = CStr(varNew)
.Update
End With
'clean up
rst.Close
Set rst = Nothing
dbs.Close
Set dbs = Nothing
End Function
You can't get the values of multi-valued fields using .Value and .OldValue. These properties always return Null. As far as I know, there's no reliable way to get the old value (also, a proper audit trail doesn't need an old value, since the old value is the previously added new value if everything gets audited properly).
When only saving the new values, and if you're saving them into a text field and not a multivalued field, you could use the following:
Use this function to get a string value for all selected items:
Public Function JoinMVF(MVFControl As Control, Optional Delimiter As String) As String
Dim i As Variant
For Each i In MVFControl.ItemsSelected
JoinMVF = JoinMVF & MVFControl.ItemData(i) & Delimiter
Next i
End Function
And then, adjust your recordset piece to the following:
With rst
.AddNew
!FormName = strFormName
!ControlName = strControlName
If strField = "" Then
!FieldName = strControlName
Else
!FieldName = strField
End If
!RecordID = lngID
!UserName = Environ("username")
If Not IsNull(varOld) Then 'varOld will always be Null for a multi-valued field
!OldValue = CStr(varOld) 'Thus this will never get called
End If
'Add some If multivalued field then
!NewValue = JoinMVF(Screen.ActiveControl, "; ")
.Update
End With
I need help with some VBA code in Microsoft Access that will produce the maximum/minimum values for each of the fields below and return with their corresponding case attached
Force Table
case Flxmax Flxmin Frxmax Frxmin
hs00p16010od 582.24 666.81 796.44 -451.15
hs00p16015od 878.7 878.7 1096.3 -500.36
hs00p16020od 1071.95 1071.9 1281.2 -743.05
hs00p16025od 1186.65 1186.6 1397.8 -959.36
Desired Output
Field Force Case
Flxmax 1186.65 hs00p16025od
Flxmin 666.81 hs00p16010od
Frxmax 1397.8 hs00p16025od
Frxmin -959.36 hs00p16025od
In addition, if there are identical max/min values in the table I need to pick just one in the results.
There are 30 additional fields to the ones shown above. I believe that I have to loop through each field till I reach the end and record the max/min row, but I'm unsure how to write this code. Any help would be great.
Current Code
Public Sub Max()
Dim sqlStatement As String
Dim rs1 As Object
Dim rs2 As Object
Dim fld As Field
Dim strName As String
Dim maximum As Long
Dim minimum As Long
sqlStatement = "SELECT * FROM Force;"
Set rs1 = CurrentDb().OpenRecordset(sqlStatement)
sqlStatement = "SELECT * FROM Results;"
Set rs2 = CurrentDb().OpenRecordset(sqlStatement)
rs2.AddNew 'Add new record to result table
'Field order to loop though: max, min, skip, max, min, skip...where skip implies a skipped field
For Each fld In rs1.Fields
With rs1
maximum = DMax(fld, Force)
'Write onto results tables
End With
Next fld
rs2.Update 'Update results table
Set rs1 = Nothing
Set rs2 = Nothing
End Sub
You are quite close. What basically is missing is that every min/max field value must be added/updated separately to the target table.
Revised Code
Public Sub Max()
Dim db As DAO.Database
Dim rs1 As DAO.Recordset
Dim rs2 As DAO.Recordset
Dim fld As DAO.Field
Dim newvalue As Long
Dim newfield As String
Dim newcase As String
Dim sqlStatement As String
Set db = CurrentDb
sqlStatement = "SELECT * FROM Force;"
Set rs1 = db.OpenRecordset(sqlStatement)
sqlStatement = "SELECT * FROM Results;"
Set rs2 = db.OpenRecordset(sqlStatement)
For Each fld In rs1.Fields
rs1.MoveFirst
newfield = fld.Name
If newfield <> "case" Then
newvalue = rs1(newfield).Value
While Not rs1.EOF
If Right(newfield, 3) = "min" Then
If newvalue > rs1(newfield).Value Then
newvalue = rs1(newfield).Value
newcase = rs1("Case").Value
End If
ElseIf Right(newfield, 3) = "max" Then
If newvalue < rs1(newfield).Value Then
newvalue = rs1(newfield).Value
newcase = rs1("Case").Value
End If
End If
rs1.MoveNext
Wend
rs2.AddNew
rs2!Field.Value = newfield
rs2!Force.Value = newvalue
rs2!Case.Value = newcase
rs2.Update
End If
Next fld
Set fld = Nothing
Set rs1 = Nothing
Set rs2 = Nothing
Set db = Nothing
End Sub
This is air code and I don't have test data. You may need to add some error handling.
I have the following code to loop through two tables and merge them into a new table:
Public Function MyFunction()
Dim Db As DAO.Database
Dim rst(1 To 3) As DAO.Recordset
Dim fld As DAO.Field
Dim fldname, fldtype As String
Dim PxID As Integer
Dim Iter, Counter As Integer
Set Db = CurrentDb
Set rst(1) = Db.OpenRecordset("Table1")
Call PrepTable ' Creates table named Test
rst(1).MoveFirst
Do While Not rst(1).EOF
PxID = rst(1)!PersonID
Set rst(2) = Db.OpenRecordset("SELECT * FROM Table2 WHERE PersonID=" & PxID)
If rst(2).RecordCount > 0 Then
rst(2).MoveLast
'set limit to 4 records if recordcount > 4
Iter = IIf(rst(2).RecordCount > 4, 4, rst(2).RecordCount)
rst(2).MoveFirst
For Counter = 1 To Iter
For Each fld In rst(2).Fields
If fld.OrdinalPosition = 0 Then
fldname = "PersonID"
Else
fldname = fld.Name & Trim(Str(Counter))
End If
If Not IsNull(fld.Value) Then
Set rst(3) = Db.OpenRecordset("Test")
'create new record on Test only if on new record on Table2
If (fldname = "PersonID" And Counter = 1) Then
rst(3).AddNew
Else
rst(3).Move 0
rst(3).Edit
End If
rst(3)(fldname).Value = fld.Value
rst(3).Update
rst(3).Bookmark = rst(3).LastModified 'not sure about this at all
End If
Next
rst(2).MoveNext
Next
rst(3).Close
End If
rst(2).Close
Set rst(2) = Nothing
Set rst(3) = Nothing
rst(1).MoveNext
Loop
rst(1).Close
Set rst(1) = Nothing
Debug.Print "Done."
Db.TableDefs.Refresh
DoCmd.OpenTable "Test", acViewNormal
End Function
Table1 contains 10 records. This function correctly creates 10 records on the Test table. However, only the first record is being updated (causing new data to overwrite the old). The last 9 records are blank save for the autonumber field of table Test and the PersonID field.
The basic question is: How do I move to the next row for the edit and update?
What you are trying to accomplish is really not entirely clear.
From what I understand, you are trying to transpose the first 4 records of Table2 into columns in table Temp.
Here, you are opening your rs(3) every for every field you loop through, but you never close it within that loop; you close it outside of the loop, at a level where it may not even be open...
So, first thing is to move that Set rst(3) = Db.OpenRecordset("Test") outside of all the loops.
Then it's not clear why you are doing with the rst(3).Move 0 and the rst(3).Bookmark = rst(3).LastModified.
Once you have added a new record, you do not need to call Edit on it again, or move around records and bookmakrs. All you need to do is make sure you call rst(3).Update after you copied all the field data.
Public Function MyFunction()
Dim Db As DAO.Database
Dim rst(1 To 3) As DAO.Recordset
Dim fld As DAO.Field
Dim fldname, fldtype As String
Dim PxID As Integer
Dim Iter, Counter As Integer
Set Db = CurrentDb
Set rst(1) = Db.OpenRecordset("Table1")
Call PrepTable ' Creates table named Test
rst(1).MoveFirst
Set rst(3) = Db.OpenRecordset("Test")
Do While Not rst(1).EOF
PxID = rst(1)!PersonID
Set rst(2) = Db.OpenRecordset("SELECT * FROM Table2 WHERE PersonID=" & PxID)
If rst(2).RecordCount > 0 Then
rst(2).MoveLast
'set limit to 4 records if recordcount > 4
Iter = IIf(rst(2).RecordCount > 4, 4, rst(2).RecordCount)
rst(2).MoveFirst
For Counter = 1 To Iter
For Each fld In rst(2).Fields
If fld.OrdinalPosition = 0 Then
fldname = "PersonID"
Else
fldname = fld.Name & Trim(Str(Counter))
End If
If Not IsNull(fld.Value) Then
'create new record on Test only if on new record on Table2
If (fldname = "PersonID" And Counter = 1) Then
rst(3).AddNew
End If
rst(3)(fldname).Value = fld.Value
End If
Next
If rs(3).EditMode <> dbEditNone Then
rst(3).Update
End If
rst(2).MoveNext
Next
End If
rst(2).Close
Set rst(2) = Nothing
rst(1).MoveNext
Loop
rst(3).Close
rst(1).Close
Set rst(3) = Nothing
Set rst(1) = Nothing
Debug.Print "Done."
Db.TableDefs.Refresh
DoCmd.OpenTable "Test", acViewNormal
End Function
I'm not saying this will work, and you could certainly clean up the logic in that code, but this should make it a bit better already.
I have to document an MS Access database with many many macros queries, etc. I wish to use code to extract each SQL query to a file which is named the same as the query, eg if a query is named q_warehouse_issues then i wish to extract the SQL to a file named q_warehouse_issues.sql
I DO NOT WISH TO EXPORT THE QUERY RESULT SET, JUST THE SQL!
I know I can do this manually in Access, but i am tired of all the clicking, doing saveas etc.
This should get you started:
Dim db As DAO.Database
Dim qdf As DAO.QueryDef
Set db = CurrentDB()
For Each qdf In db.QueryDefs
Debug.Print qdf.SQL
Next qdf
Set qdf = Nothing
Set db = Nothing
You can use the File System Object or the built-in VBA File I/O features to write the SQL out to a file. I assume you were asking more about how to get the SQL than you were about how to write out the file, but if you need that, say so in a comment and I'll edit the post (or someone will post their own answer with instructions for that).
Hope this helps.
Public Function query_print()
Dim db As Database
Dim qr As QueryDef
Set db = CurrentDb
For Each qr In db.QueryDefs
TextOut (qr.Name)
TextOut (qr.SQL)
TextOut (String(100, "-"))
Next
End Function
Public Sub TextOut(OutputString As String)
Dim fh As Long
fh = FreeFile
Open "c:\File.txt" For Append As fh
Print #fh, OutputString
Close fh
End Sub
This solution include fields in query
Public Sub ListQueries()
' Author: Date: Contact:
' André Bernardes 09/09/2010 08:45 bernardess#gmail.com http://al-bernardes.sites.uol.com.br/
' Lista todas as queries da aplicação.
' Listening:
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim l As Integer
On Error Resume Next
For i = 0 To CurrentDb.QueryDefs.Count - 1
Debug.Print "Query: " & CurrentDb.QueryDefs(i).Name
For j = 0 To CurrentDb.QueryDefs(i).Fields.Count - 1
Debug.Print "Field " & CurrentDb.QueryDefs(i).Fields(j).Name
Next
Debug.Print " SQL: " & CurrentDb.QueryDefs(i).SQL
Next
End Sub
In the VB Window, click Tools->References....
In the References window add the dependency Microsoft Scripting Runtime by checking it off.
Then this code will export the queries to a file suitable for using grep on:
Sub ExportQueries()
Dim fso As New FileSystemObject
Dim stream As TextStream
Set stream = fso.CreateTextFile("e:\temp\queries.txt")
Dim db As DAO.Database
Dim qdf As DAO.QueryDef
Set db = CurrentDb()
For Each qdf In db.QueryDefs
stream.writeline "Name: " & qdf.Name
stream.writeline qdf.SQL
stream.writeline "--------------------------"
Next qdf
Set qdf = Nothing
Set db = Nothing
End Sub
I modified #andre-bernardes's code to use
"|" separators before the query names
and ":" separators before the SQL statements.
The different separators make it easier to parse the Queries.txt file with python and create a dictionnary of queries and SQL statements.
You can then use this dictionary to create views in an SQLite table for example.
VBA code to extract the SQL queries
Public Sub ListQueries()
' Modified from André Bernardes
Dim i As Integer
Dim ff As Long
ff = FreeFile()
Open "C:\Dev\Queries.txt" For Output As #ff
On Error Resume Next
For i = 0 To CurrentDb.QueryDefs.Count - 1
Debug.Print "|" & CurrentDb.QueryDefs(i).Name & ":"
Print #ff, "|" & CurrentDb.QueryDefs(i).Name & ":"
Debug.Print CurrentDb.QueryDefs(i).SQL
Print #ff, CurrentDb.QueryDefs(i).SQL
Next
End Sub
Python code to parse Queries.txt into a dictionary
queries_file = open(data_path + '/Queries.txt')
queries = queries_file.read().split('|')
l = [x.split(':') for x in queries]
l.pop(0)
table_name_to_query = {name: query for name, query in l}
Create SQLite views from the Access queries
import sqlite3
conn = sqlite3.connect('example.db')
c = conn.cursor()
for table, query in table_name_to_query.items():
try:
c.execute("CREATE VIEW `%s` AS %s" % (table,query))
print("\n\n"+ table + " passed")
print(query)
except Exception as e:
print("\n\n"+ table + " error")
print(e)
print(query)