VBA to update file properties - ms-access

I have a table in my access database that contains an index of project files and their associated properties. The fields include things like Filename, Filepath, Date Created, Date Modified, etc.
I'd like to create some code to loop through every record in this table and update file properties that may have changed - specifically, the date modified and file size.
The table is tblFileIndex and the relevant fields are File_Path, File_Size and Date_Modified. The filepath is the full path, including file name, to the file so it seems to me it should be pretty easy to use that field to find the file and then update the file size and date modified.
I'm not sure how to go about creating the code to loop through the table and do this though. I'd like the code to be assigned to a button on a form I have for maintenance functions as this will be run semi-frequently as part of a maintenance routine.
Below is some example code but I get Invalid use of Null errors from sFilePath = rs.Fields("File_Path") when it reaches the end of the record set.
Private Sub Command4_Click()
Dim rs As Recordset
Dim sFilePath As String
Dim oFS As Object
Set oFS = CreateObject("Scripting.FileSystemObject")
Set rs = CurrentDb.OpenRecordset("tblFileIndex")
Do While Not rs.EOF
sFilePath = rs.Fields("File_Path")
MsgBox sFilePath
rs.MoveNext
Loop
End Sub
It looks like after I sort this out Ill need to add the following:
.Edit
rs.Fields("File_Size") = oFS.GetFile(sFilePath).Size
.Update
.Edit
rs.Fields("Date_Modified") = oFS.GetFile(sFilePath).DateLastModified
.Update
rs.MoveNext

Ok, let's clean up things:
Private Sub Command4_Click()
Dim rs As Recordset
Dim sFilePath As String
Dim oFS As Object
Set oFS = CreateObject("Scripting.FileSystemObject")
Set rs = CurrentDb.OpenRecordset("tblFileIndex")
with rs
.moveFirst
do
sFilePath = .Fields("File_Path")
.Edit
.Fields("File_Size") = oFS.GetFile(sFilePath).Size
.Fields("Date_Modified") = oFS.GetFile(sFilePath).DateLastModified
.Update
.moveNext
loop until .EOF
.Close ' Always close recordsets
end with
End Sub
Alternate notation for getting/setting RecordSet field values:
' ...
with rs
.moveFirst
do
sFilePath = ![File_Path]
.edit
![File_Size] = oFS.GetFile(sFilePath).Size
' ...
.update
.moveNext
loop until .EOF
end with
' ...
end with
' ...

I get Invalid use of Null errors from sFilePath = rs.Fields("File_Path") when it reaches the end of the record set.
Since your loop is controlled by Do While Not rs.EOF, that error suggests you have a row with Null in File_Path.
See whether that error goes away when you load the recordset with only rows where File_Path is not Null.
Dim strSelect As String
strSelect = "SELECT * FROM tblFileIndex WHERE File_Path Is Not Null;"
Set rs = CurrentDb.OpenRecordset(strSelect)

Related

Microsoft Access Database - Downloading ALL attachments from MULTIPLE entries

I am currently trying to download many .doc files that are attached to the Microsoft Access record under the "Attachment" field which is labeled as "File/Attachment". However, I need the ability to run a query (Search By Loss Incident) which I did prior and then run the macro to download ALL the attachments from multiple records. This is my code below, I need some help with it! I am getting an error of "This expression you entered has a function containing the wrong number of arguments".
Option Compare Database
Public Function SaveAttachmentsTest(strPath As String, Optional strPattern As String = "*.*") As Long
Dim dbs As DAO.database
Dim rst As DAO.Recordset
Dim rsA As DAO.Recordset2
Dim fld As DAO.Field2
Dim strFullPath As String
'Get the database, recordset, and attachment field
Set dbs = CurrentDb
Set rst = dbs.OpenRecordset("Search By Loss Incident Name")
Set fld = rst("File/Attachment")
'Navigate through the table
Do While Not rst.EOF
'Get the recordset for the Attachments field
Set rsA = fld.Value
'Save all attachments in the field
Do While Not rsA.EOF
If rsA("FileName") Like strPattern Then
'To Export the data, use the line below
strFullPath = "C:\Users\Emmanuel\Desktop\Test" & "\" & rsA("FileName")
'Make sure the file does not exist and save
If Dir(strFullPath) = "" Then
rsA("FileData").SaveToFile strFullPath
End If
'Increment the number of files saved
SaveAttachmentsTest = SaveAttachmentsTest + 1
End If
'Next attachment
rsA.MoveNext
Loop
rsA.Close
'Next record
rst.MoveNext
Loop
rst.Close
dbs.Close
Set fld = Nothing
Set rsA = Nothing
Set rst = Nothing
Set dbs = Nothing
End Function
Introduce a local variable:
<snip>
Dim SavedAttachments As Long
<snip>
' Increment the number of files saved.
SaveAttachments = SaveAttachments + 1
End If
<snip>
Set fld = Nothing
Set rsA = Nothing
Set rst = Nothing
Set dbs = Nothing
' Return the count of saved files.
SaveAttachmentsTest = SaveAttachments
End Function

Duplicate records in Subform to New record

I have a table for my assemblies in a manufacturing process [Shedmodels]. The components are listed in a separate table [ShedModelsComponents]. The primary key in [ShedModels] is [ModelNumber]. There is a field in [ShedModelsComponents] also called [ModelNumber]. Each component is thus assigned to a certain Assembly in table [ShedModels]. Next I have created a form for [ShedModels] with a subform for [ShedModelsComponents] embedded. All the components for the assembly appear like I want. So far, so good. Now many of my assemblies use almost the same components, so I would like to copy or perhaps append all the components from one assembly to a new record in [Shed Models]. I have found this code on MS website.
Private Sub btnDuplicate_Click()
Dim dbs As DAO.Database, Rst As DAO.Recordset
Dim F As Form
' Return Database variable pointing to current database.
Set dbs = CurrentDb
Set Rst = Me.RecordsetClone
On Error GoTo Err_btnDuplicate_Click
' Tag property to be used later by the append query.
Me.Tag = Me![ModelNumber]
' Add new record to end of Recordset object.
With Rst
.AddNew
!ModelNumber = Me!ModelNumber
!ModelDesc = Me!ModelDesc
!ModelSalePrice = Me!ModelSalePrice
.Update ' Save changes.
.Move 0, .LastModified
End With
Me.Bookmark = Rst.Bookmark
' Run the Duplicate Order Details append query which selects all
' detail records that have the OrderID stored in the form's
' Tag property and appends them back to the detail table with
' the OrderID of the duplicated main form record.
DoCmd.SetWarnings False
DoCmd.OpenQuery "Duplicate Shed Models Components"
DoCmd.SetWarnings True
'Requery the subform to display the newly appended records.
Me![Shed_Models_Query].Requery
Exit_btnduplicate_Click:
Exit Sub
Err_btnDuplicate_Click:
MsgBox Error$
Resume Exit_btnduplicate_Click:
End Sub
but it returns the error that this would create duplicate Model numbers, which I don't doubt. How can I copy my assembly with all the components to a new record, but change the Model Number (which would be user entered)?
First, copy the parent record (like you do). But don't let the form move to the new record.
Next, obtain the new PK.
Then, copy the child records using the new PK. This is a skeleton - you would use the RecordsetClone of the subform. See below.
Finally, move the parent form to the new record. The subform will automatically update.
Public Sub CopyRecords()
Dim rstSource As DAO.Recordset
Dim rstInsert As DAO.Recordset
Dim fld As DAO.Field
Dim strSQL As String
Dim lngLoop As Long
Dim lngCount As Long
strSQL = "SELECT * FROM tblStatus WHERE Location = '" & _
"DEFx" & "' Order by Total"
' Change this to the RecordsetClone of the subform.
Set rstInsert = CurrentDb.OpenRecordset(strSQL)
Set rstSource = rstInsert.Clone
With rstSource
lngCount = .RecordCount
For lngLoop = 1 To lngCount
With rstInsert
.AddNew
For Each fld In rstSource.Fields
With fld
If .Attributes And dbAutoIncrField Then
' Skip Autonumber or GUID field.
ElseIf .Name = "ParentID" ' Name of FK.
rstInsert.Fields(.Name).Value = NewID ' The new ID of the parent.
ElseIf .Name = "Total" Then
' Insert some default value.
rstInsert.Fields(.Name).Value = 0
ElseIf .Name = "PROCESSED_IND" Then
' Empty a field.
rstInsert.Fields(.Name).Value = Null
Else
' Copy field content.
rstInsert.Fields(.Name).Value = .Value
End If
End With
Next
.Update
End With
.MoveNext
Next
rstInsert.Close
.Close
End With
Set rstInsert = Nothing
Set rstSource = Nothing
End Sub

access vba - grab the results in the code

I am working on an access application and I am trying to do the following:
the user insert input to a search, and then I search in my db, and I want to manipulate the results (generate an html file and put the results in there).
so I have a form with one input, there the user insert something he wants to search.
then it redirects to another form, with following on_load code:
Private sub form_load()
dim str as string
set frm = screen.activeForm 'gets the last form
str = frm!search 'the input the user entered
task = "SELECT * FROM results WHERE (condition)" 'some query with the db and the input
Me.recordSource = taks
end sub
this form gets the results and prints them.
now, I see the results on my form. but, what I want is: to get the results and manipulate them in the code, for example, make an array with all the results ids and not to print it to the user.
is that possible?
You should open a Recordset with your query, loop on it's results,and apply your logic within the loop.
For instance, you can call my sub below after your :
Me.recordSource = taks
For_Instance taks ' Call my sub and pass it your SQL instruction
And here's the sub in question that you purt in your form and containing your logic:
Private Sub For_Instance(strSQL As String)
Dim DB As dao.Database
Dim RST As dao.Recordset
Dim lngID As Long
Dim strMyField As String
Dim lngCount As Long
Dim i As Long
Set DB = CurrentDb
Set RST = DB.OpenRecordset(strSQL)
If RST.BOF Then Exit Sub ' no records found, stop.
' If you want to know how many record you have prior to loop, do:
RST.MoveLast
lngCount = RST.RecordCount
Debug.Print "There are " & lngCount & " to process."
' Let's loop on your recordset now...
' first, reposition on first record:
RST.MoveFirst
' Then start to loop
While Not RST.EOF
' This is where you do your stuff with the records
' You can grab the data that is in the current line of you recordset like this:
' RST!name_of_the_field
' name_of_the_field refers to your column names
' Suppose you have a column named ID with type long, to get the current ID, do:
lngID = RST!ID
' Suppose you have a column named MyField with type string
strMyField = RST!MyField
' and do whatever you want
' And finally you go to the next record and continue your stuff
RST.MoveNext
i = i + 1
Wend
' When you arrive here, you have processed all your records
MsgBox "All done, I have processed " & i & " records"
'Close your recordset
RST.Close
'Clean your objects
Set RST = Nothing
Set DB = Nothing
End Sub
Something like this will let you connect vba to your database and get the data out:
Sub vbaRecords()
Dim db As DAO.Database
Dim rst As DAO.Recordset
Dim SQLstr As String
Set db=CurrentDb
SQLstr = "SELECT * FROM results WHERE (condition)" ' You'll need to flesh this out to have the same condition as you've used previously.
Set rst = db.OpenRecordset(SQLstr)
' Then you can move around the recordset. Assuming you want to start at the beginning:
rst.MoveFirst
' Then you can access individual items
vbitem1 = rst!item1
' You can also loop through the different records, if there's more than 1 (your condition can narrow this down)
do until rst.EOF
' Grab items from each record in here and do something with them
rst.MoveNext
Loop
' Then close and end the connections
rst.Close
db.Close
Set rst = Nothing
Set db = Nothing
End sub
Just open a recordset using the same SQL:
SELECT * FROM results WHERE (condition)
and browse the records as needed.
Read up on the Recordset class. You can use it like this to get the results of the query into an object:
Dim rs As DAO.Recordset
Set rs = CurrentDb.OpenRecordset("SELECT * FROM results WHERE (condition)", dbOpenDynaset, dbFailOnError + dbSeeChanges)
From there you can run through it, query and manipulate it as you like.

Access only filtered values in a MS Access table

Is it possible to get the values from rows in an Access table that are showing after the filter is applied?
Example as requested:
I have a table in which employees fill in project tasks, hours on the project etc.
It is made as a table on a form. The columns has limited choices in Initials, Project number, etc. People like to sort the table by the built in filter function in access tables and queries. I filtered so only the project LT1075 is shown in the example.
How can i get those 4 rows as a recordset or something similar? I need to get the values in all hour fields. I need also to copy only those 4 lines in VBA and do stuff to it (Functions wanted by people). But when i use the DAO, i get all rows in the "Unfiltered" table.
How do i get only the rows visible?
In excel, there is a simple function, something with cells_visible but i cant find a pardon to Access.
Best Regards, Emil.
Edit, tryouts:
Public Sub Test1_Click()
Dim rs As DAO.Recordset
Set rs = Me.RecordsetClone
While Not rs.EOF
' Do calculation stuff on record.
rs.MoveNext
Wend
End Sub
It is put on the "Test 1" button in the figure above.
I get the error: "Runtime error 7951 - You entered an expression that has an invalid reference to the RecordsetClone property"
I have a clue that it does not work because of the Me.* function? Since the table is in some sort of subform. But i see only one form in the Navigation panel. (Hidden are also showed).
You can use the RecordsetClone of the form:
Dim rs As DAO.Recordset
Set rs = Me.RecordsetClone
While Not rs.EOF
' Do calculation stuff on record.
rs.MoveNext
Wend
And you can add records to a recordset:
Public Sub CopyRecords()
Dim rstSource As DAO.Recordset
Dim rstInsert As DAO.Recordset
Dim fld As DAO.Field
Dim strSQL As String
Dim lngLoop As Long
Dim lngCount As Long
strSQL = "SELECT TOP 1 * FROM tblStatus"
Set rstInsert = CurrentDb.OpenRecordset(strSQL)
' rstSource can be any recordset, here the RecordsetClone of the form.
Set rstSource = Me.RecordsetClone
With rstSource
While Not .EOF
With rstInsert
.AddNew
For Each fld In rstSource.Fields
With fld
If .Attributes And dbAutoIncrField Then
' Skip Autonumber or GUID field.
ElseIf .Name = "Total" Then
' Special cases.
' Insert default job code.
rstInsert.Fields(.Name).Value = 0
ElseIf .Name = "PROCESSED_IND" Then
rstInsert.Fields(.Name).Value = vbNullString
Else
' Copy field content.
rstInsert.Fields(.Name).Value = .Value
End If
End With
Next
.Update
End With
.MoveNext
Next
rstInsert.Close
.Close
End With
Set rstInsert = Nothing
Set rstSource = Nothing
End Sub

Code to loop through all records in MS Access

I need a code to loop through all the records in a table so I can extract some data. In addition to this, is it also possible to loop through filtered records and, again, extract data? Thanks!
You should be able to do this with a pretty standard DAO recordset loop. You can see some examples at the following links:
http://msdn.microsoft.com/en-us/library/bb243789%28v=office.12%29.aspx
http://www.granite.ab.ca/access/email/recordsetloop.htm
My own standard loop looks something like this:
Dim rs As DAO.Recordset
Set rs = CurrentDb.OpenRecordset("SELECT * FROM Contacts")
'Check to see if the recordset actually contains rows
If Not (rs.EOF And rs.BOF) Then
rs.MoveFirst 'Unnecessary in this case, but still a good habit
Do Until rs.EOF = True
'Perform an edit
rs.Edit
rs!VendorYN = True
rs("VendorYN") = True 'The other way to refer to a field
rs.Update
'Save contact name into a variable
sContactName = rs!FirstName & " " & rs!LastName
'Move to the next record. Don't ever forget to do this.
rs.MoveNext
Loop
Else
MsgBox "There are no records in the recordset."
End If
MsgBox "Finished looping through records."
rs.Close 'Close the recordset
Set rs = Nothing 'Clean up
In "References", import DAO 3.6 object reference.
private sub showTableData
dim db as dao.database
dim rs as dao.recordset
set db = currentDb
set rs = db.OpenRecordSet("myTable") 'myTable is a MS-Access table created previously
'populate the table
rs.movelast
rs.movefirst
do while not rs.EOF
debug.print(rs!myField) 'myField is a field name in table myTable
rs.movenext 'press Ctrl+G to see debuG window beneath
loop
msgbox("End of Table")
end sub
You can interate data objects like queries and filtered tables in different ways:
Trhough query:
private sub showQueryData
dim db as dao.database
dim rs as dao.recordset
dim sqlStr as string
sqlStr = "SELECT * FROM customers as c WHERE c.country='Brazil'"
set db = currentDb
set rs = db.openRecordset(sqlStr)
rs.movefirst
do while not rs.EOF
debug.print("cust ID: " & rs!id & " cust name: " & rs!name)
rs.movenext
loop
msgbox("End of customers from Brazil")
end sub
You should also look for "Filter" property of the recordset object to filter only the desired records and then interact with them in the same way (see VB6 Help in MS-Access code window), or create a "QueryDef" object to run a query and use it as a recordset too (a little bit more tricky). Tell me if you want another aproach.
I hope I've helped.
Found a good code with comments explaining each statement.
Code found at - accessallinone
Sub DAOLooping()
On Error GoTo ErrorHandler
Dim strSQL As String
Dim rs As DAO.Recordset
strSQL = "tblTeachers"
'For the purposes of this post, we are simply going to make
'strSQL equal to tblTeachers.
'You could use a full SELECT statement such as:
'SELECT * FROM tblTeachers (this would produce the same result in fact).
'You could also add a Where clause to filter which records are returned:
'SELECT * FROM tblTeachers Where ZIPPostal = '98052'
' (this would return 5 records)
Set rs = CurrentDb.OpenRecordset(strSQL)
'This line of code instantiates the recordset object!!!
'In English, this means that we have opened up a recordset
'and can access its values using the rs variable.
With rs
If Not .BOF And Not .EOF Then
'We don’t know if the recordset has any records,
'so we use this line of code to check. If there are no records
'we won’t execute any code in the if..end if statement.
.MoveLast
.MoveFirst
'It is not necessary to move to the last record and then back
'to the first one but it is good practice to do so.
While (Not .EOF)
'With this code, we are using a while loop to loop
'through the records. If we reach the end of the recordset, .EOF
'will return true and we will exit the while loop.
Debug.Print rs.Fields("teacherID") & " " & rs.Fields("FirstName")
'prints info from fields to the immediate window
.MoveNext
'We need to ensure that we use .MoveNext,
'otherwise we will be stuck in a loop forever…
'(or at least until you press CTRL+Break)
Wend
End If
.close
'Make sure you close the recordset...
End With
ExitSub:
Set rs = Nothing
'..and set it to nothing
Exit Sub
ErrorHandler:
Resume ExitSub
End Sub
Recordsets have two important properties when looping through data, EOF (End-Of-File) and BOF (Beginning-Of-File). Recordsets are like tables and when you loop through one, you are literally moving from record to record in sequence. As you move through the records the EOF property is set to false but after you try and go past the last record, the EOF property becomes true. This works the same in reverse for the BOF property.
These properties let us know when we have reached the limits of a recordset.