Option Compare Database
Option Explicit
Private WithEvents LV As ListView
Private Sub Form_Load()
Set LV = Me.lvFiles.Object
End Sub
Private Sub LV_OLEDragDrop(Data As MSComctlLib.DataObject, Effect As Long, Button As Integer, Shift As Integer, x As Single, y As Single)
Dim i As Integer
Dim Path As String
If Data.Files.Count > 0 Then MsgBox "Processing " & Data.Files.Count & " files"
For i = 1 To Data.Files.Count
InsertFileIntoAttachment Me.DocID, Data.Files.Item(i)
Next i
End Sub
Public Sub ProcessFiles(DocPath As String)
Dim strSql As String
strSql = "Insert into tblDocuments (docPath) values ('" & DocPath & "')"
CurrentDb.Execute strSql
End Sub
Sub InsertFileIntoAttachment(DocID As Long, FilePath As String)
Dim db As DAO.Database
Dim rsTable As DAO.Recordset
Dim rsAttachment As DAO.Recordset2
Dim strFilePath As String
Dim YourRecordID As Long ' Example for finding a specific record
' Set the path to the file you want to attach
strFilePath = FilePath ' Adjust this path and filename
YourRecordID = DocID ' Replace with the actual ID of the record you want to modify
On Error GoTo ErrorHandler
' Set DAO objects
Set db = CurrentDb
Set rsTable = db.OpenRecordset("tblDocuments", dbOpenDynaset) ' Replace YourTableName
' Find the specific record
rsTable.FindFirst "DocID = " & DocID ' Replace IDFieldName
If Not rsTable.NoMatch Then
rsTable.Edit ' Enable editing of the current record
' Set the attachment field recordset
Set rsAttachment = rsTable.Fields("ATT").Value ' Replace YourAttachmentFieldName
' Add the new attachment
rsAttachment.AddNew
rsAttachment.Fields("FileData").LoadFromFile strFilePath
rsAttachment.Update
rsTable.Update ' Save changes to the main record
MsgBox "Added Attachement " & FilePath
Else
MsgBox "Record with ID " & YourRecordID & " not found.", vbExclamation
End If
ExitSub:
' Clean up objects
If Not rsAttachment Is Nothing Then rsAttachment.Close
If Not rsTable Is Nothing Then rsTable.Close
Set rsAttachment = Nothing
Set rsTable = Nothing
Set db = Nothing
Exit Sub
ErrorHandler:
If Not Err.Number = 3420 Then MsgBox "An error occurred: " & Err.Number & " " & Err.Description, vbCritical
' Resume ExitSub
End Sub