仅查看Access报告中最近添加的附件

时间:2018-05-16 17:17:10

标签: vba ms-access access-vba ms-access-2010

我使用访问数据库作为游泳池的会员管理应用程序。我使用一份报告打印出所有带有图片ID的季票。该报告使用查询仅打印已拍摄照片的顾客的通行证。

enter image description here

SELECT tblPassHolders.[PASS HOLDER NAME], tblPassHolders.PHOTO.FileData, tblPassHolders.BARCODE, tblPassHolders.[FAMILY PASS], tblFamilyPass.Expires
FROM tblFamilyPass INNER JOIN tblPassHolders ON tblFamilyPass.ID = tblPassHolders.FamilyID
WHERE (((tblPassHolders.PHOTO.FileData) Is Not Null) AND ((tblFamilyPass.Expires)>Now()) AND ((tblPassHolders.Printed)=False));

这是使用该应用程序的第二年,而我遇到的问题是当人们为他们的通行证重新拍照时,我的报告打印出每张照片的通行证附件附在他们的记录上。

我非常喜欢Access,而且我正在努力弄清楚如何编辑我的报告/查询,以便报告只为每个赞助人打印一个通行证最新照片附在他们的唱片上。一种解决方案是简单地删除旧照片,因此只有一个附件,但即使有多个附件,我也想知道如何使其工作。我一直在玩DLast(),但我很确定我做错了。

如何进行仅显示最近添加的附件的查询?

1 个答案:

答案 0 :(得分:1)

以下是我建议你可以做的一个例子,而不是找到最近添加的附件。

正如所讨论的那样,除非你实现某种将最新文件弹出到顶部的命名约定,否则这是不可能的,因为Microsoft按文件名的顺序显示了附件字段。

以下是一个示例,您可以使用按钮来控制插入附件。 它基于Stack Overflow example

完成测试后,您可以将Cancel=True添加到Photo_DblClick事件中,以完全控制您的照片附件字段

Private Sub cmdAddNewPhoto_Click()

    Dim rsPhotos        As DAO.Recordset2
    Dim rsParent        As DAO.Recordset2

    Dim strImagePath    As String

    If MsgBox("Add New Photo?", vbQuestion + vbOKCancel, "Add Photo?") = vbOK Then

        ' Get New Photo
        ' Note that you need to add a reference to Microsoft Office ##.0 Object Library
        ' using Tools | References... from the VBA interface for the file picker to work
        With Application.FileDialog(msoFileDialogFilePicker)
            ' Prevent multiple selections
            .AllowMultiSelect = False
            ' Set the caption of the dialog box
            .Title = "Please select a photo"
            ' Add filters for common image formats
            .Filters.Clear
            .Filters.Add "JPG Files (JPG)", "*.JPG"
            .Filters.Add "JPEG Files (JPEG)", "*.JPEG"
            .Filters.Add "PNG Files", "*.PNG"
            .Filters.Add "Bitmap Files", "*.BMP"

            If .Show = True Then ' File selected
                strImagePath = .SelectedItems.item(1)
            End If
        End With

        If strImagePath <> "" Then

            ' First clear all old photos if desired
            If Photo.AttachmentCount > 0 Then
                If MsgBox("Clear Previous Photo(s)?", vbQuestion + vbOKCancel, "Remove All Photos?") = vbOK Then
                    ' Clear previous attachments
                    ' (we only want one attachment at a time)
                    Set rsPhotos = Me.Recordset.Fields("Photo").Value
                    With rsPhotos
                        Do While Not .EOF
                            .Delete
                            .MoveNext
                        Loop
                        .Close
                    End With
                    ' Clear last displayed photo
                    Photo.Requery
                End If
            End If

            ' Put parent record in edit mode
            Set rsParent = CurrentDb.OpenRecordset(Me.RecordSource, dbOpenDynaset)
            With rsParent
                ' Get Cureent Matching Record using Primary Key
                .FindFirst "BarCode = " & Me!barcode
                .Edit
                DoEvents
            End With

            ' Next Add the attachment selected by the user
            Set rsPhotos = rsParent.Fields("Photo").Value
            With rsPhotos
                .AddNew
                .Fields("FileData").LoadFromFile strImagePath
                If Photo.AttachmentCount > 0 Then
                    ' Rename so it pops up to first file - and keep extension
                    .Fields("Filename").Value = "00000LatestPic" & Mid$(strImagePath, InStrRev(strImagePath, "."))
                End If
                .Update
                .Close
            End With

            ' Update the parent record
            With rsParent
                .Update
                .Close
            End With

            Set rsPhotos = Nothing
            Set rsParent = Nothing

            ' Refresh Photo Display
            Photo.Requery
        End If
    End If
End Sub