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 SaveAllAttachmentsToFile(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
If SavePath = "" Then SavePath = CurrentProject.Path & "\"
If Right(SavePath, 1) <> "\" Then SavePath = SavePath & "\"
If Not (rsAll.BOF And rsAll.EOF) Then rsAll.MoveFirst
Do While Not rsAll.EOF 'Recordset of all records
Set rsAtt = rsAll.Fields(attachmentFieldName).Value
Do While Not rsAtt.EOF
fileName = rsAtt.Fields("FileName").Value
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.
rsAtt.Fields("FileData").SaveToFile (SavePath & fileName)
'Print and delete
ExecuteFile SavePath & fileName, PrintFile
VBA.Kill SavePath & fileName
End If
Else
rsAtt.Fields("FileData").SaveToFile (SavePath & fileName)
'Print and delete
ExecuteFile SavePath & fileName, PrintFile
VBA.Kill SavePath & fileName
End If
rsAtt.MoveNext
Loop 'The recordset of attachments for a record
Exit Sub
rsAll.MoveNext
Loop 'The complete recordset
End Sub