将图片加载到附件数据类型中，并在 access 中链接文件名

Question

所以我有一个 table 访问权限，其中包含我一直用作表格链接以查看图片的文件名。我想将这些移动到照片的附件数据库中，这样我就可以将数据库分发给其他人，而不必也复制文件路径名。

我开始编写一些代码来尝试，但不确定如何遍历文件路径，因为我选择了特定的图像。

这里是一些数据的示例...所以我会使用 Tassel 照片文件路径并将图片上传到带有数据类型附件的 PhotoT 列。

编辑：

我更新了代码以使其正常工作。我在前面的 table 中添加了一个列导入。并为每一列添加了单独的编码部分。效果很好！我的数据库大小增加到 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

Answer 1

所以从图中看来，您需要使用包含文件 url 的列遍历 table 的行，然后将该文件附加到附件类型列中同一个文件。假设：

这是执行此操作的代码。

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"

将图片加载到附件数据类型中，并在 access 中链接文件名

Load pictures into attachment data type with linked file names in access

ms-access

photo