所以我有一個訪問表，其中包含我一直用作表單中的鏈接來查看圖片的檔案名。我想將這些移動到照片附件資料庫中，這樣我就可以將資料庫分發給其他人，而不必復制檔案路徑名。
我開始了一些代碼來嘗試，但不確定如何遍歷檔案路徑，因為我選擇了特定的影像。
這是一些資料的示例......所以我會采用流蘇照片檔案路徑并將圖片上傳到帶有資料型別附件的 PhotoT 列。
編輯：
我更新了我的代碼以使其正常作業。我在上一個表中添加了一個列匯入。并為每列添加了單獨的編碼部分。它作業得很好！我的資料庫大小增加到 1.7GB。它最初只有 30mb，需要更新 60mb 的圖片。也不知道所有的存盤都去了哪里。速度快了很多，現在它是獨立的，所以很棒。如果我有更多的照片，我將不得不想出別的東西哈哈
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
uj5u.com熱心網友回復：
因此，從圖片看來，您需要遍歷表的行，其中一列包含檔案的 url，然后將該檔案附加到同一檔案中的附件型別列。假設：
這是執行此操作的代碼。
Public Sub MovethroughTableAttachingPhotos(TableName As String, urlColumnName As String, attachmenttypeColumnName As String)
'adapted from https://docs.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"
轉載請註明出處，本文鏈接：https://www.uj5u.com/gongcheng/314249.html
上一篇：MS訪問兩個表之間的多個關系