Solved Access vba Manage an Attachment field with vba (1 Viewer)

P

Papashep

New member
Local time
Today, 12:14
Joined
Oct 13, 2013
Messages
15
Hi
I am trying to check if an attachment exists on a recordset2 record and if it does remove the field contents and then add a new attachment to the same record so I Only have the one attachment entry on the record. My code is giving me two problems:
1. The If statement If .Fields("Logo").Type = dbAttachment And Not IsNull(!Logo.value) This is failing in that currently the Logo field does not contain an attachment and within that code block, I then get my next problem
2. The statement .Fields("Logo").value.Attachments.Delete fails with the error code 438 Object doesn't support this property or method.

Can anyone help please, this is the first time I have tried to manage any attachments.

I am using Access 365 64bit on a WIndows 11 PC

Below is the function that I am calling

Code: 
Public Function GetLogo(CompID As Integer) As String
    On Error GoTo ErrHandler

    Dim db As DAO.Database
    Dim rst As DAO.Recordset2
    Dim fDialog As FileDialog
    Dim sFilePath As String

    Set db = CurrentDb
    Set rst = db.OpenRecordset("SELECT * FROM Company WHERE Company.CompanyID =" & CompID)

    ' Set up the File Dialog
    Set fDialog = Application.FileDialog(msoFileDialogFilePicker)

    With fDialog
        .Title = "Please select a Logo file"
        .Filters.Clear
        .Filters.Add "Image Files", "*.jpg; *.jpeg; *.png; *.bmp; *.gif"

        ' Show the dialog and get the file path
        If .Show = -1 Then
            sFilePath = .SelectedItems(1)
        Else
            MsgBox "You clicked Cancel in the file dialog box."
            Exit Function
        End If
    End With

    With rst
        If Not .EOF Then
            ' Check if the Logo field contains attachments
            If .Fields("Logo").Type = dbAttachment And Not IsNull(!Logo.value) Then
                ' Clear existing attachments
                .Edit
                .Fields("Logo").value.Attachments.Delete
                .Update
            End If

            ' Add the new attachment
            .Edit
            .Fields("Logo").value.Attachments.Add sFilePath
            .Update
        Else
            MsgBox "No record found for CompanyID " & CompID
        End If
    End With

    Exit Function

ErrHandler:
    MsgBox "Error Line: " & Erl & " Error number " & Err.Number & ": " & Err.Description
    Resume Next
End Function
 
P

Pat Hartman

Super Moderator
Staff member
Local time
Today, 07:14
Joined
Feb 19, 2002
Messages
43,275
If you only need a single logo per company, use the OLE Object data type rather than the Attachment.
 
P

Papashep

New member
Local time
Today, 12:14
Joined
Oct 13, 2013
Messages
15
Hi Pat

Thanks for your response, but what I want to know is how to manage attachment fields

Kind Regards Melvyn
 
arnelgp

arnelgp

..forever waiting... waiting for jellybean!
Local time
Today, 19:14
Joined
May 7, 2009
Messages
19,243
Code: 
Public Function GetLogo(CompID As Integer) As String
    On Error GoTo ErrHandler

    Dim db As DAO.Database
    Dim rst As DAO.Recordset2
    Dim fDialog As FileDialog
    Dim sFilePath As String

    Set db = CurrentDb
    Set rst = db.OpenRecordset("SELECT * FROM Company WHERE Company.CompanyID =" & CompID, dbOpenDynaset)

    ' Set up the File Dialog
    Set fDialog = Application.FileDialog(msoFileDialogFilePicker)

    With fDialog
        .Title = "Please select a Logo file"
        .Filters.Clear
        .Filters.Add "Image Files", "*.jpg; *.jpeg; *.png; *.bmp; *.gif"

        ' Show the dialog and get the file path
        If .Show = -1 Then
            sFilePath = .SelectedItems(1)
        Else
            MsgBox "You clicked Cancel in the file dialog box."
            Exit Function
        End If
    End With

    If Not (rst.BOF And rst.EOF) Then
        rst.MoveFirst
        rst.Edit
        
        With .Fields("Logo").Value
        
            If Not .EOF Then
                'replace the attachment
                .Edit
                .Fields("FileData").LoadFromFile sFilePath
                .Update
            
            Else
                MsgBox "No record found for CompanyID " & CompID
            End If
        
        End With
        
        rst.Update
    End If
    rst.Close

ExitFunc:
    Set rst = Nothing
    Set db = Nothing
    Exit Function

ErrHandler:
    MsgBox "Error Line: " & Erl & " Error number " & Err.Number & ": " & Err.Description
    Resume ExitFunc
End Function
 
P

Papashep

New member
Local time
Today, 12:14
Joined
Oct 13, 2013
Messages
15
arnelgp said:
Code: 
Public Function GetLogo(CompID As Integer) As String
    On Error GoTo ErrHandler

    Dim db As DAO.Database
    Dim rst As DAO.Recordset2
    Dim fDialog As FileDialog
    Dim sFilePath As String

    Set db = CurrentDb
    Set rst = db.OpenRecordset("SELECT * FROM Company WHERE Company.CompanyID =" & CompID, dbOpenDynaset)

    ' Set up the File Dialog
    Set fDialog = Application.FileDialog(msoFileDialogFilePicker)

    With fDialog
        .Title = "Please select a Logo file"
        .Filters.Clear
        .Filters.Add "Image Files", "*.jpg; *.jpeg; *.png; *.bmp; *.gif"

        ' Show the dialog and get the file path
        If .Show = -1 Then
            sFilePath = .SelectedItems(1)
        Else
            MsgBox "You clicked Cancel in the file dialog box."
            Exit Function
        End If
    End With

    If Not (rst.BOF And rst.EOF) Then
        rst.MoveFirst
        rst.Edit
       
        With .Fields("Logo").Value
       
            If Not .EOF Then
                'replace the attachment
                .Edit
                .Fields("FileData").LoadFromFile sFilePath
                .Update
           
            Else
                MsgBox "No record found for CompanyID " & CompID
            End If
       
        End With
       
        rst.Update
    End If
    rst.Close

ExitFunc:
    Set rst = Nothing
    Set db = Nothing
    Exit Function

ErrHandler:
    MsgBox "Error Line: " & Erl & " Error number " & Err.Number & ": " & Err.Description
    Resume ExitFunc
End Function
Click to expand...
Hi thanks for your help. I tried your code, but it gave me the error Invalid or unqualified reference on the line: With .Fields("Logo").Value
I have now found the solution which I will post in my reply.
 
P

Papashep

New member
Local time
Today, 12:14
Joined
Oct 13, 2013
Messages
15
Have now found the solution which I have shown in the code below.
The objective of the code was to find a new Logo image which I save as an attachment on my company record. I also wanted to ensure that only one image is stored in my Logo attachment field.
I have changed it from a Function to a SSub routine in my code.
I have tested the code to clear out multiple images in the attachment field and add only the select file, leaving me with just one attachment image.
Code: 
Sub AddCompanyLogo(ByVal CompID As Integer)
' ----------------------------------------------------------------
' Procedure Name: AddCompanyLogo
' Purpose: Add new Attachment, Only allows one attachment per Company record and removes any previousl created attachments
' Procedure Kind: Sub
' Procedure Access: Private
' Parameter CompID (Integer): The Company ID
' Author: Melvyn
' Date: 28/02/2024
' ----------------------------------------------------------------
   
    On Error GoTo ErrHandler

    Dim db As DAO.Database
    Dim rsMainRecords As DAO.Recordset2
    Dim rsAttachments As DAO.Recordset2
    Dim fDialog As FileDialog
    Dim sFilePath As String
    Dim fld As DAO.Field2
    Dim RecordCount As Integer

    Set db = CurrentDb
   
    ' Set up the File Dialog
    Set fDialog = Application.FileDialog(msoFileDialogFilePicker)

    With fDialog
        .Title = "Please select a Logo file"
        .Filters.Clear
        .Filters.Add "Image Files", "*.jpg; *.jpeg; *.png; *.bmp; *.gif"

        ' Show the dialog and get the file path
        If .Show = -1 Then
            sFilePath = .SelectedItems(1)
        Else
            MsgBox "You clicked Cancel in the file dialog box."
            Exit Sub
        End If
    End With
   
    Set rsMainRecords = db.OpenRecordset("SELECT * FROM Company WHERE Company.CompanyID =" & CompID, dbOpenDynaset)
    Set fld = rsMainRecords("Logo")
   
    'Get the attachment field
   
    Do Until RecordCount = 1
   
        Set rsAttachments = fld.value
       
        rsMainRecords.Edit
               
        'Remove all attachments
        Do Until rsAttachments.EOF
       
            rsAttachments.Delete
           
            rsAttachments.MoveNext
           
        Loop
           
        'Add new attchment
        rsAttachments.AddNew
        rsAttachments("FileData").LoadFromFile sFilePath
        rsAttachments.Update
       
        rsMainRecords.Update
       
        RecordCount = 1
   
    Loop

    rsMainRecords.Close
    db.Close
   
   
    Set rsMainRecords = Nothing
    Set rsAttachments = Nothing
    Set db = Nothing
   
    Exit Sub

ErrHandler:
    MsgBox "Error Line: " & Erl & " Error number " & Err.Number & ": " & Err.Description
    Resume Next
   
End Sub
 
Last edited:
You must log in or register to reply here.

Similar threads

J
error in procedure
Replies
12
Views
294
Pat Hartman
P
A
how to insert attachment in sharepoint list using ado access vba
Replies
3
Views
219
theDBguy
theDBguy
N
Solved Record set too slow with SQL server Cloud & Parameters not working
Replies
15
Views
420
cheekybuddha
cheekybuddha
C
Object Invalid or No Longer Set Error
Replies
6
Views
218
MajP
MajP
C
Solved Update a record with a recordset
Replies
10
Views
271
cheekybuddha
cheekybuddha

Users who are viewing this thread

Total: 1 (members: 0, guests: 1)
Top Bottom