What you describe sounds a little confusing. If I read the above correctly you want a pop up form bound to a table with an attachment field. If that is the case then you can use an attachment control. Not sure of the issue. Not sure I understand the whole design. Why use an unbound form? 99 times out of 100 you can do what you want with a bound form easier and faster than an unbound. Why do you need to pop up a form for the attachment control? Why are attachments in their own table?
OK, I guess it is like people who prefer to use only old fashioned hand tools to build furniture. But as you see it is making a simple task harder and causes the work around.
Public Sub OpenFirstAttachmentAsTempFile(ByRef rstCurrent As DAO.Recordset, ByVal strFieldName As String)
Dim rstChild As DAO.Recordset2
Dim fldAttach As DAO.Field2
Dim strFilePath As String
Dim strTempDir As String
strTempDir = Environ("Temp") ' Get the Temp directory from the environment variable.
If Right(strTempDir, 1) <> "\" Then strTempDir = strTempDir & "\" ' Make sure the path always ends with a backslash.
Set rstChild = rstCurrent.Fields(strFieldName).Value ' the .Value for a complex field returns the underlying recordset.
strFilePath = strTempDir & rstChild.Fields("FileName").Value ' Append the name of the first (and only) attached file to temp dir.
If Dir(strFilePath) <> "" Then ' the file already exists--delete it first.
VBA.SetAttr strFilePath, vbNormal ' remove any file attributes (e.g. read-only) that would block the kill command.
VBA.Kill strFilePath ' delete the file.
End If
Set fldAttach = rstChild.Fields("FileData") ' The binary data of the file.
fldAttach.SaveToFile strFilePath
rstChild.Close ' cleanup
VBA.Shell "Explorer.exe " & Chr(34) & strFilePath & Chr(34), vbNormalFocus ' Use Windows Explorer to launch the file.
End Sub '
Public Function OpenReportAndSave(strReportName As String) As String
'Create report and save as an attachment to the current record
Dim myCurrentDir As String
Dim myReportOutput As String
Dim myMessage As String
On Error GoTo ErrorHandler
DoCmd.OpenReport strReportName, acViewPreview
myCurrentDir = CurrentProject.Path & "\"
myReportOutput = myCurrentDir & strReportName & Format(Date, "YYYYMMDD") & ".pdf"
DoCmd.OutputTo acOutputReport, strReportName, acFormatPDF, myReportOutput, , , , acExportQualityPrint
OpenReportAndSave = myReportOutput
Exit Function
ErrorHandler:
MsgBox Error$
End Function
Public Sub loadAttachFromFile(strPath As String, rsAll As DAO.Recordset, attachmentFieldName As String)
'An attachment field has a recordset of attachments stored behind the scenes
Dim rsAtt As DAO.Recordset
'Add a new record to the tables recordset
Set rsAtt = rsAll.Fields(attachmentFieldName).Value
rsAll.Edit
rsAtt.AddNew
'This is the confusing part. The value property of an attachment field returns a recordset of attachments
'All recordset of attachments has a field named filedata which holds the data.
'The loadfromfile data loads an attachment from a path
rsAtt.Fields("FileData").LoadFromFile (strPath)
rsAtt.Update
rsAll.Update
End Sub
Public Sub SaveAttachToFile(rsAll As DAO.Recordset, attachmentFieldName As String, Optional SavePath As String = "")
'An attachment field has a recordset of attachments stored behind the scenes
Dim rsAtt As DAO.Recordset
Dim fileName As String
Set rsAtt = rsAll.Fields(attachmentFieldName).Value
If rsAtt.BOF And rsAtt.EOF Then
MsgBox "No Attachment"
Exit Sub
End If
fileName = rsAtt.Fields("FileName").Value
If SavePath = "" Then SavePath = CurrentProject.Path & "\"
If Right(SavePath, 1) <> "\" Then SavePath = SavePath & "\"
If Dir(SavePath & fileName) <> "" Then ' the file already exists--delete it first.
If MsgBox("File already exists. Do you want to overwrite?", vbYesNo, "Overwrite?") = vbYes Then
VBA.SetAttr SavePath & fileName, vbNormal ' remove any file attributes (e.g. read-only) that would block the kill command.
VBA.Kill SavePath & fileName ' delete the file.
Else
Exit Sub
End If
End If
rsAtt.Fields("FileData").SaveToFile (SavePath & fileName)
End SubPrivate Sub cmdAttachReport_Click()
Dim tempLocation As String
Dim fldName As String
Dim rs As DAO.Recordset
Set rs = Me.Recordset
fldName = "Attachments"
tempLocation = OpenReportAndSave("rptProductsByCategory")
loadAttachFromFile tempLocation, rs, "Attachments"
'if you want to remove the temp file
VBA.Kill tempLocation
End Sub
Private Sub cmdOpenAttach_Click()
Dim rs As DAO.Recordset
Set rs = Me.RecordsetClone
OpenFirstAttachmentAsTempFile rs, "Attachments"
End Sub
Private Sub cmdSaveAttach_Click()
Dim SavePath As String
SavePath = "C:"
SaveAttachToFile Me.Recordset, "Attachments", SavePath
End Sub
