如何将Access中图片路径批量导入为附件类型字段并关联对应文件名

我在Access中有一张存储了文件名的表，此前我一直通过这些文件名在表单中创建链接以查看图片。现在我想要将这些图片导入到数据库的附件类型字段中，这样我就可以直接将数据库分发给他人，无需额外拷贝文件路径对应的本地图片。

我最初尝试编写代码实现该功能，但不确定如何遍历我选定的特定图片对应的文件路径。

我的业务需求为：提取雄穗（Tassel）照片的文件路径，将图片上传到数据类型为附件的PhotoT字段中，数据示例如下：

编辑补充：
我已经更新代码完成了功能实现。我在原表中新增了导入字段，并且为每个目标附件字段编写了独立的代码段，运行效果很好。不过原本仅30MB的数据库加上60MB待导入图片后，体积涨到了1.7GB，暂时不清楚额外占用的存储空间来源。但数据库运行速度提升了很多，现在也完全自包含，体验很好。如果后续还有更多图片需要导入的话，我就得另寻方案了。

完整实现代码 #

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
    
    
    '''''''''''''''''''''''''''''
    ' 自动给表新增附件字段
    '''''''''''''''''''''''''''''
    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 rstChild = rst.Fields("PT").Value
    
    If rstChild.RecordCount <= 0 Then
    ' 遍历所有记录导入图片
    Do While Not rst.EOF
         Tasselpath = rst!Tassel

         rst.Edit
         Set rsA = rst.Fields("PT").Value
         rsA.AddNew
         rsA("FileData").LoadFromFile Tasselpath
         rsA.Update
         rsA.Close
        
         rst.Update
         ' 跳转下一条记录
         rst.MoveNext
    Loop
    End If
        '''''''''''''''''''''''''''''
    ' 导入花丝（Silk）图片
    '''''''''''''''''''''''''''''
    strsql = "SELECT InbredPicPaths.* FROM InbredPicPaths WHERE (((InbredPicPaths.Silk)<>''))"
    Set rst = dbs.OpenRecordset(strsql)
    Set rstChild = rst.Fields("PS").Value
    
    If rstChild.RecordCount <= 0 Then
    Do While Not rst.EOF
         Tasselpath = rst!Silk

         rst.Edit
         Set rsA = rst.Fields("PS").Value
         rsA.AddNew
         rsA("FileData").LoadFromFile Tasselpath
         rsA.Update
         rsA.Close
        
         rst.Update
         rst.MoveNext
    Loop
    End If
        '''''''''''''''''''''''''''''
    ' 导入气生根（BraceRoot）图片
    '''''''''''''''''''''''''''''
    strsql = "SELECT InbredPicPaths.* FROM InbredPicPaths WHERE (((InbredPicPaths.BraceRoot)<>''))"
    Set rst = dbs.OpenRecordset(strsql)
    Set rstChild = rst.Fields("PBR").Value
    
    If rstChild.RecordCount <= 0 Then
    Do While Not rst.EOF
         Tasselpath = rst!BraceRoot

         rst.Edit
         Set rsA = rst.Fields("PBR").Value
         rsA.AddNew
         rsA("FileData").LoadFromFile Tasselpath
         rsA.Update
         rsA.Close
        
         rst.Update
         rst.MoveNext
    Loop
    End If
        '''''''''''''''''''''''''''''
    ' 导入果穗（Ear）图片
    '''''''''''''''''''''''''''''
    strsql = "SELECT InbredPicPaths.* FROM InbredPicPaths WHERE (((InbredPicPaths.Ear)<>''))"
    Set rst = dbs.OpenRecordset(strsql)
    Set rstChild = rst.Fields("PE").Value
    
    If rstChild.RecordCount <= 0 Then
    Do While Not rst.EOF
         Tasselpath = rst!Ear

         rst.Edit
         Set rsA = rst.Fields("PE").Value
         rsA.AddNew
         rsA("FileData").LoadFromFile Tasselpath
         rsA.Update
         rsA.Close
        
         rst.Update
         rst.MoveNext
    Loop
    
    End If
    
    rst.Close
    Set rst = Nothing
    Set rsA = Nothing
    Set dbs = Nothing
    Set rstChild = Nothing
    
End Sub

内容的提问来源于stack exchange，提问作者FrosyFeet456