I am trying to set all Nulls in a table (tblIdea) to NS but the following code throws an 'Object Required' error and highlights the line starting with 'If.'
Sub CommitNS()
Dim db As dao.Database
Dim tdf As dao.TableDef
Dim fld As dao.Field
Set db = CurrentDb
Set tdf = db.TableDefs("tblIdea")
For Each fld In tdf.Fields
If fld Is Null Then
fld = "NS"
End If
Next fld
Set tdf = Nothing
Set db = Nothing
End Sub
You miss the actual update:
Sub CommitNS()
Dim db As DAO.Database
Dim rst As DAO.Recordset
Dim fld As DAO.Field
Dim Update As Boolean
Set db = CurrentDb
Set rst = db.OpenRecordset("Select * From tblIdea")
While Not rst.EOF
For Each fld In rst.Fields
If IsNull(fld.Value) Then
Update = True
Exit For
End If
Next
If Update = True Then
' Record needs update.
rst.Edit
For Each fld In rst.Fields
If IsNull(fld.Value) Then
fld.Value = "NS"
End If
Next
rst.Update
Update = False
End If
rst.MoveNext
Wend
rst.Close
Set fld = Nothing
Set rst = nothing
Set db = Nothing
End Sub
Related
So I have a table in access with file names I have been using as links in a form to view pictures. I would like to move these into an attachment database of photos so I can distribute the database to others without having to copy the file path names too.
I started some code to try it but not sure how to loop through the file paths because I have specific images I choose.
Here is an example of some of the data...so I would take the Tassel photo filepath and upload the picture to column PhotoT with datatype attachment.
EDIT:
I updated my code to get this to work. I added in a column import to the previous table. and added in seperate coding sections for each column. It works great! My database increased in size to 1.7gb. It was originally only 30mb with 60mb of pictures to update. Not sure where all the storage went too. The speed is a lot faster and its now self contained so thats great. If i had anymore picture i would have had to figure something else out haha
Option Compare Database
Option Explicit
Sub test()
Dim dbs As DAO.Database
Dim rst As DAO.Recordset
Dim rsA As DAO.Recordset
Dim fld As DAO.Field
Dim tdf As DAO.TableDef
Dim rstChild As Recordset2
Dim strsql As String
Dim noRows As String
Dim Tasselpath As String
'''''''''''''''''''''''''''''
'add columns to table
'''''''''''''''''''''''''''''
If DoesTblFieldExist("InbredPicPaths", "PE") = False Then
Set dbs = CurrentDb
Set tdf = dbs.TableDefs("InbredPicPaths")
Set fld = tdf.CreateField("PT", dbAttachment)
tdf.Fields.Append fld
Set fld = tdf.CreateField("PS", dbAttachment)
tdf.Fields.Append fld
Set fld = tdf.CreateField("PE", dbAttachment)
tdf.Fields.Append fld
Set fld = tdf.CreateField("PBR", dbAttachment)
tdf.Fields.Append fld
Set tdf = Nothing
End If
'''''''''''''''''''''''''''''
'Tassel
'''''''''''''''''''''''''''''
Set dbs = CurrentDb
strsql = "SELECT InbredPicPaths.* FROM InbredPicPaths WHERE (((InbredPicPaths.Tassel)<>''))"
Set rst = dbs.OpenRecordset(strsql)
'Set fld = rst("Tassel")
Set rstChild = rst.Fields("PT").Value
If rstChild.RecordCount <= 0 Then
'Navigate through the table
Do While Not rst.EOF
'Get the recordset for the Attachments field
Tasselpath = rst!Tassel
rst.Edit
Set rsA = rst.Fields("PT").Value
rsA.AddNew
rsA("FileData").LoadFromFile Tasselpath
rsA.Update
rsA.Close
rst.Update
'Next record
rst.MoveNext
Loop
End If
'''''''''''''''''''''''''''''
'silk
'''''''''''''''''''''''''''''
' Set dbs = CurrentDb
strsql = "SELECT InbredPicPaths.* FROM InbredPicPaths WHERE (((InbredPicPaths.Silk)<>''))"
Set rst = dbs.OpenRecordset(strsql)
'Set fld = rst("Silk")
Set rstChild = rst.Fields("PS").Value
If rstChild.RecordCount <= 0 Then
'Navigate through the table
Do While Not rst.EOF
'Get the recordset for the Attachments field
Tasselpath = rst!Silk
rst.Edit
Set rsA = rst.Fields("PS").Value
rsA.AddNew
rsA("FileData").LoadFromFile Tasselpath
rsA.Update
rsA.Close
rst.Update
'Next record
rst.MoveNext
Loop
End If
'''''''''''''''''''''''''''''
'Braceroot
'''''''''''''''''''''''''''''
'Set dbs = CurrentDb
strsql = "SELECT InbredPicPaths.* FROM InbredPicPaths WHERE (((InbredPicPaths.BraceRoot)<>''))"
Set rst = dbs.OpenRecordset(strsql)
'Set fld = rst("BraceRoot")
Set rstChild = rst.Fields("PBR").Value
If rstChild.RecordCount <= 0 Then
'Navigate through the table
Do While Not rst.EOF
'Get the recordset for the Attachments field
Tasselpath = rst!BraceRoot
rst.Edit
Set rsA = rst.Fields("PBR").Value
rsA.AddNew
rsA("FileData").LoadFromFile Tasselpath
rsA.Update
rsA.Close
rst.Update
'Next record
rst.MoveNext
Loop
End If
'''''''''''''''''''''''''''''
'Ear
'''''''''''''''''''''''''''''
'Set dbs = CurrentDb
strsql = "SELECT InbredPicPaths.* FROM InbredPicPaths WHERE (((InbredPicPaths.Ear)<>''))"
Set rst = dbs.OpenRecordset(strsql)
' Set fld = rst("Ear")
Set rstChild = rst.Fields("PE").Value
If rstChild.RecordCount <= 0 Then
'Navigate through the table
Do While Not rst.EOF
'Get the recordset for the Attachments field
Tasselpath = rst!Ear
rst.Edit
Set rsA = rst.Fields("PE").Value
rsA.AddNew
rsA("FileData").LoadFromFile Tasselpath
rsA.Update
rsA.Close
rst.Update
'Next record
rst.MoveNext
Loop
End If
rst.Close
Set rst = Nothing
Set rsA = Nothing
Set dbs = Nothing
Set rstChild = Nothing
End Sub
So from the picture it looks like you need to iterate through the rows of a table with a column containing the url of a file and then attach that file to an attachment type column in the same file. Assuming:
Here is code that does that.
Public Sub MovethroughTableAttachingPhotos(TableName As String, urlColumnName As String, attachmenttypeColumnName As String)
'adapted from https://learn.microsoft.com/en-us/office/vba/access/concepts/data-access-objects/work-with-attachments-in-dao
Dim db As Database
Set db = CurrentDb
Dim rsTable As Recordset
Dim rsPhotos As Recordset
Set rsTable = db.OpenRecordset(TableName)
rsTable.MoveFirst 'avoids an error
Dim currentURL As String
Do Until rsTable.EOF
currentURL = rsTable(urlColumnName)
rsTable.Edit
Set rsPhotos = rsTable.Fields(attachmenttypeColumnName).value
rsPhotos.AddNew
rsPhotos.Fields("FileData").LoadFromFile (currentURL)
rsPhotos.Update
rsPhotos.Close 'placing here avoids an error
rsTable.Update
rsTable.MoveNext
Loop
'clean up
rsTable.Close
Set rsPhotos = Nothing
Set rsTable = Nothing
Set db = Nothing
End Sub
'to call the subroutine : MovethroughTableAttachingPhotos "Photos", "PhotoAddress", "PhotoAttachment"
I tried using SQL but with no success. I then tried DAO, the other fields
seems to work but the column which holds attachments fails. Has someone done this before?
Private Sub copyfromtblA_Click()
Dim db As Database
Dim rs1 As DAO.Recordset
Dim rs2 As DAO.Recordset
Dim rs3 As DAO.Recordset2
'Set db = CurrentDb()
Set rs1 = db.OpenRecordset("tblA")
Set rs2 = db.OpenRecordset("tblB")
With rs2
rs2.AddNew
rs2.Fields("ItemNo").Value = Me.ItemNo.Value
rs2.Fields("Quantity").Value = Me.Quantity.Value
rs2.Fields("itemName").Value = Me.itemName.Value
'This is were I get the error since this field contains images as attachments
rs2.Fields("ItemImage").Value = Me.itemImage.Value
rs2.Update
rs1.MoveNext
End With
rs2.Close
Form.Requery
Set rs2 = Nothing
rs1.Close
Set rs1 = Nothing
End Sub
Something like this:
Private Sub copyfromtblA_Click()
Dim db As Database
Dim rs1 As DAO.Recordset
Dim rs2 As DAO.Recordset
Dim rsAtt1 As DAO.Recordset2
Dim rsAtt2 As DAO.Recordset2
Set db = CurrentDb()
Set rs2 = db.OpenRecordset("tblB")
With Me.Recordset
rs2.AddNew
rs2.Fields("ItemNo").Value = !ItemNo.Value
rs2.Fields("Quantity").Value = !Quantity.Value
rs2.Fields("itemName").Value = !itemName.Value
Set rsAtt1 = !ItemImage.Value
Set rsAtt2 = rs2!ItemImage.Value
With rsAtt1
Do While Not .EOF
rsAtt2.AddNew
rsAtt2.Fields("FileData") = .Fields("FileData")
rsAtt2.Fields("FileName") = .Fields("FileName")
rsAtt2.Update
.MoveNext
Loop
End With
rs2.Update
End With
rs2.Close
Set rs2 = Nothing
rsAtt1.Close
Set rsAtt1 = Nothing
'I was getting an error here! removing the "rsAtt2.Close" solved the problem
'rsAtt2.Close
Set rsAtt2 = Nothing
End Sub
The below is my code. A simple loop to go through records in a query (qryMasterImageFolders) and then call the sub fs.listImages...
However, I keep receiving the 3061 error and the below line is highlighted:
Set rst = qdf.OpenRecordset()
The query does contain records and I have checked the spelling - what am I missing?
Dim db As DAO.Database
Dim rst As DAO.Recordset
Dim qdf As DAO.QueryDef
Set db = CurrentDb
Set qdf = db.QueryDefs("qryMasterImageFolders")
Set rst = qdf.OpenRecordset()
With rst
Do Until .EOF
fs.listImages DLookup("ImageFolder", "qryMasterImageFolders")
.MoveNext
Loop
End With
rst.Close
Set rst = Nothing
Set qdf = Nothing
Set db = Nothing
I have changed my code and it is now working:
Dim rs As DAO.Recordset
Set rs = CurrentDb.OpenRecordset("SELECT ImageFolder FROM tmpImagePaths")
'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
fs.listImages DLookup("ImageFolder", "qryMasterImageFolders")
'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
What you should have done:
Set rs = db.OpenRecordset("qryMasterImageFolders")
I am unable to get the count of records by openining Ms Access Query, I use the following code.
Private Sub CmdGetData_Click()
Dim WRK As Workspace
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim StrSql As String
Set WRK = DBEngine.Workspaces(0)
Set db = CurrentDb
StrSql = "select * from [QrySalePatti]"
Set rs = db.OpenRecordset(StrSql, dbOpenDynaset)
Do While (Not rs.EOF)
rs.MoveFirst
rs.MoveLast
MsgBox rs.RecordCount
Loop
exitRoutine:
If Not (db Is Nothing) Then
db.Close
Set db = Nothing
End If
Set WRK = Nothing
End Sub
You should not need a Do While loop to get the RecordCount.
Set rs = db.OpenRecordset(StrSql, dbOpenDynaset)
With rs
If Not (.BOF And .EOF) Then
.MoveLast
End If
MsgBox .RecordCount
End With
However if your goal is only to count the rows from QrySalePatti, you could use a SELECT Count(*) query and read the value returned from that.
StrSql = "SELECT Count(*) AS row_count FROM [QrySalePatti]"
Set rs = db.OpenRecordset(StrSql)
MsgBox rs!row_count
Or you could use a DCount expression.
MsgBox DCount("*", "QrySalePatti")
I'm grabbing field row from one table and creating a new table for each row. The new tables will have names equal to the row they correspond to.
Here is my code:
Option Compare Database
Public Function createTables()
Dim db As DAO.Database
Dim tdf As DAO.TableDef
Dim rst As DAO.Recordset
Dim fld As DAO.Field
Dim strSQL As String
strSQL = "Select SKUS from SKUS"
Set db = CurrentDb()
Set rst = db.OpenRecordset(strSQL)
Set fld = rst.Fields("SKUS")
'MsgBox fld.Value
rst.MoveFirst
Do While Not rst.EOF
Set tdf = db.CreateTableDef(fld.Value)
Set fld = tdf.CreateField("SKUS", dbText, 30)
tdf.Fields.Append fld
Set fld = tdf.CreateField("Count", dbInteger)
tdf.Fields.Append fld
db.TableDefs.Append tdf
rst.MoveNext
Loop
End Function
The problem is that after the first iteration of the code (the first table is created), it gives me an error "Invalid operation" pointing to the line
...
Set tdf = db.CreateTableDef(fld.Value)
...
Why do you think this is? I have a feeling its because I need to re set fld or rst, but I'm not sure.
Can anyone help me out with this?
Thanks!
It doesn't seem like you're reading any new tuples from rst, thus the CreateTableDef will be called with the same value repeatedly. Try changing this:
[...]
Set fld = rst.Fields("SKUS")
rst.MoveFirst
Do While Not rst.EOF
Set tdf = db.CreateTableDef(fld.Value)
[...]
Into this:
[...]
rst.MoveFirst
Do While Not rst.EOF
Set fld = rst.Fields("SKUS")
Set tdf = db.CreateTableDef(fld.Value)
[...]
...if your intention is to create one table based on every tuple in the SKUS table.