使用VBA将大量附件导入Microsoft Access

Using VBA to import a large number of attachment into Microsoft Access

我正在尝试将大量图像(约 1000 张)附加到 Microsoft Access。 我认为使用 VBA 来自动执行任务比手动执行更明智。

我不想link hyperlink 或路径或 OLE 到文件的位置,这会降低数据库的文件大小。 (编辑:据了解,Ms Access 有 2Gb 的限制,我假设在这种情况下不会超过 2Gb 的限制。)

我要执行所有这些操作的数据库名为 "database1"。我要导入图像的 table 名为 "Table1"。 在此 table 中,到目前为止有 3 列:

1) auto-generated ID,我保持原样

2) 标题为 "file_name" 的列,当前为 "image1"、"image2"、"image3" 等。或者我可以将条目更改为此列作为文件在我电脑上的路径(例如 C:\Users\Username\Documents\image1.jpg)。我已经使用 .bat 文件生成了我计算机上所有图像路径的列表,并将其命名为 .txt 文件,该文件名为 "file_paths"。

3) 标题为 "attachment_column" 的列。这是我希望将图像放入我的数据库中的列。

我希望根据第 2 列中的 file_name 将图像导入相应的数据库条目,如果可能的话。

我一直在查看各种文档并进行了尝试,但都没有成功。 https://msdn.microsoft.com/VBA/Access-VBA/articles/work-with-attachments-in-dao https://access-programmers.co.uk/forums/showthread.php?t=172939

我衣柜里的东西是下面这样的。但我不知道如何遍历 file_paths.txt 中的所有文件路径来附加所有图像。

Sub macrotest2()

   Dim db As DAO.Database
   Dim rs As DAO.Recordset
   Set db = CurrentDb 'I guess I don't have to define as database1 ?
   Set rsEMployees = db.OpenRecordset("Table1", dbOpenDynaset)

   rsEMployees.Edit

   Set rsPictures = rsEMployees.Fields("attachment_column").Value

   rsPictures.AddNew
   rsPictures.Fields("attachment_column").LoadFromFile "C:\Users\Username\Documents\image1.jpg"
'how to automate this to loop all the file paths in file_paths.txt?

   rsPictures.Update
   rsEMployees.Update
End Sub

在此先感谢您。

试试这个:

Dim fileName As String, textRow As String, fileNo As Integer
fileName = "C:\file_paths.txt"
fileNo = FreeFile 'Get first free file number  
Dim i as Integer
Dim db As DAO.Database
Dim rsEmployees As DAO.Recordset, rsPictures AS DAO.Recordset
Set db = CurrentDb()
Open fileName For Input As #fileNo
Do While Not EOF(fileNo)
    i = i + 1
    Set rsEmployees = db.OpenRecordset("Table1", dbOpenDynaset)   
    rsEmployees.Edit
    rsEmployees.AddNew
    Line Input #fileNo, textRow
    rsEmployees.Fields("file_name").Value = textRow
    Set rsPictures = rsEmployees.Fields("attachment_column").Value
    rsPictures.AddNew
    rsPictures.Fields("FileData").LoadFromFile textRow
    rsPictures.Update
    rsPictures.Close
    rsEmployees.Update
    rsEmployees.Close
Loop
Close #fileNo
MsgBox i

有多种方法可以逐行通过,但我喜欢这种。

请注意,您的文本文件中不能有空行。即使是最后一行也需要包含一个文件 link.