Results 1 to 9 of 9
  1. #1
    MXQ's Avatar
    MXQ is offline Novice
    Windows 10 Office 365
    Join Date
    Aug 2020
    Posts
    9

    Question Import picture as attachment into Access

    Dear friends, I need your support. Iím trying to import a user pic into an Access form. The import itself is successful so far but it gives me a runtime error 3420 on line
    Code:
    rsAttachments.Close
    in the following code:
    Code:
    Dim db As DAO.Database
        Dim rsContacts As DAO.Recordset2
        Dim rsAttachments As DAO.Recordset2
        Dim fldattachment As DAO.Field2
    
        Set db = CurrentDb
        Set rsContacts = Me.Recordset
    
        If Not rsContacts.EOF And Not rsContacts.BOF Then
            rsContacts.Edit
            Set fldattachment = rsContacts.Fields("Attachments")
            Set rsAttachments = fldattachment.Value
    
            ' Activate edit mode.
            rsAttachments.AddNew
    
            ' Add the attachment.
            rsAttachments.Fields("FileData").LoadFromFile "\\Path to folder..\" & Me![Last Name] & " " & Me![First Name] & ".jpg"
            rsAttachments.Update
    
            ' Increment the counter.
            AddAttachment = AddAttachment + 1
    
            ' Save the changes to the parent record.
            rsContacts.Update
    
            ' Close the child and parent recordsets.
            rsAttachments.Close
            rsContacts.Close
        End If
    
        Set fldattachment = Nothing
        Set rsAttachments = Nothing
        Set rsContacts = Nothing
        Set db = Nothing
    
        ' enable Add Mode for the form
        Me.AllowAdditions = True
    I tried it without rsAttachments.Close and then simply replaced it with Set rsAttachments = Nothing


    That didn't work either.
    Can someone give me a hint or point me to the right direction how to avoid error 3420 in this case?
    Thank you in advance!

  2. #2
    ranman256's Avatar
    ranman256 is offline VIP
    Windows Vista Access 2010 32bit
    Join Date
    Apr 2014
    Location
    Kentucky
    Posts
    9,432
    Importing images, you run the risk of filling up your db.
    I would recommend to store the PATH of the image to keep the db size low,
    which can be opened via : OpenNativeApp txtbox


    Store the path to the file in the field, and it will open ANY file in its native application.

    Paste this code into a module
    Code:
    #If Win64 Then      'Public Dclare PtrSafe Function
      Private Declare PtrSafe Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpszOp As String, ByVal lpszFile As String, ByVal lpszParams As String, ByVal lpszDir As String, ByVal FsShowCmd As Long) As Long
      Private Declare PtrSafe Function GetDesktopWindow Lib "user32" () As Long
    #else
      Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpszOp As String, ByVal lpszFile As String, ByVal lpszParams As String, ByVal lpszDir As String, ByVal FsShowCmd As Long) As Long
      Private Declare Function GetDesktopWindow Lib "user32" () As Long
    #End If
    
    
    
    
    Const SW_SHOWNORMAL = 1
    Const SE_ERR_FNF = 2&
    Const SE_ERR_PNF = 3&
    Const SE_ERR_ACCESSDENIED = 5&
    Const SE_ERR_OOM = 8&
    Const SE_ERR_DLLNOTFOUND = 32&
    Const SE_ERR_SHARE = 26&
    Const SE_ERR_ASSOCINCOMPLETE = 27&
    Const SE_ERR_DDETIMEOUT = 28&
    Const SE_ERR_DDEFAIL = 29&
    Const SE_ERR_DDEBUSY = 30&
    Const SE_ERR_NOASSOC = 31&
    Const ERROR_BAD_FORMAT = 11&
    
    
    
    
    Public Sub OpenNativeApp(ByVal psDocName As String)
    Dim r As Long, msg As String
    
    
    r = StartDoc(psDocName)
    If r <= 32 Then
        'There was an error
        Select Case r
            Case SE_ERR_FNF
                msg = "File not found"
            Case SE_ERR_PNF
                msg = "Path not found"
            Case SE_ERR_ACCESSDENIED
                msg = "Access denied"
            Case SE_ERR_OOM
                msg = "Out of memory"
            Case SE_ERR_DLLNOTFOUND
                msg = "DLL not found"
            Case SE_ERR_SHARE
                msg = "A sharing violation occurred"
            Case SE_ERR_ASSOCINCOMPLETE
                msg = "Incomplete or invalid file association"
            Case SE_ERR_DDETIMEOUT
                msg = "DDE Time out"
            Case SE_ERR_DDEFAIL
                msg = "DDE transaction failed"
            Case SE_ERR_DDEBUSY
                msg = "DDE busy"
            Case SE_ERR_NOASSOC
                msg = "No association for file extension"
            Case ERROR_BAD_FORMAT
                msg = "Invalid EXE file or error in EXE image"
            Case Else
                msg = "Unknown error"
        End Select
    '    MsgBox msg
    End If
    End Sub
    
    
    
    
    Private Function StartDoc(psDocName As String) As Long
    Dim Scr_hDC As Long
    
    
    Scr_hDC = GetDesktopWindow()
    StartDoc = ShellExecute(Scr_hDC, "Open", psDocName, "", "C:\", SW_SHOWNORMAL)
    End Function

  3. #3
    June7's Avatar
    June7 is online now VIP
    Windows 10 Access 2010 32bit
    Join Date
    May 2011
    Location
    The Great Land
    Posts
    52,074
    What is the exact error message?
    How to attach file: http://www.accessforums.net/showthread.php?t=70301 To provide db: copy, remove confidential data, run compact & repair, zip w/Windows Compression.

  4. #4
    Join Date
    Jan 2017
    Location
    Swansea,South Wales,UK
    Posts
    3,725
    Why do WE have to google for the error message all the time?

    https://answers.microsoft.com/en-us/...7-a6f765e3952b

    Walk through your code with F8 and a breakpoint. If you do not set rsAttachments, you cannot close it?
    Please use # icon on toolbar when posting code snippets.
    Cross Posting: https://www.excelguru.ca/content.php?184
    Debugging Access: https://www.youtube.com/results?sear...bug+access+vba

  5. #5
    Micron is online now Virtually Inert Person
    Windows 10 Access 2016
    Join Date
    Jun 2014
    Location
    Ontario, Canada
    Posts
    11,969
    Why do WE have to google for the error message all the time?
    You don't - you can do what I do much (not all) of the time. Read and move on. Same as when a whole lot of code gets pasted in without using code tags (not saying that happened here). Usually I won't bother to try and read it. Keeps me sane (ok, maybe keeps me from getting crazier).
    The more we hear silence, the more we begin to think about our value in this universe.
    Paraphrase of Professor Brian Cox.

  6. #6
    Join Date
    Jan 2017
    Location
    Swansea,South Wales,UK
    Posts
    3,725
    Looking at it again?, why would a recordset be a value? Perhaps it was never set in the first place.
    I have not worked with attachments, just links to same.

    I would still walk the code though, check that rsAttachments is actually set. though I would expect other errors earlier to be present if it was not?
    Please use # icon on toolbar when posting code snippets.
    Cross Posting: https://www.excelguru.ca/content.php?184
    Debugging Access: https://www.youtube.com/results?sear...bug+access+vba

  7. #7
    MXQ's Avatar
    MXQ is offline Novice
    Windows 10 Office 365
    Join Date
    Aug 2020
    Posts
    9

    Thumbs up [SOLVED] Thanks to you guys!

    Quote Originally Posted by ranman256 View Post
    Importing images, you run the risk of filling up your db.
    I would recommend to store the PATH of the image to keep the db size low,
    which can be opened via : OpenNativeApp txtbox
    Dear Running Man, thank you for your answer and especially for providing the whole code. I appreciate your time and effort a lot but nonetheless I was still curious about my faulty code.
    Iím also aware of the fact that I shouldnít blow up the database with attached images but I was just wondering how I could edit attachment fields through VBA, just to learn therewith and to improve my skills.

    Quote Originally Posted by June7 View Post
    What is the exact error message?
    Quote Originally Posted by Welshgasman View Post
    Why do WE have to google for the error message all the time?

    https://answers.microsoft.com/en-us/...7-a6f765e3952b
    Hello June7, as Mr. Welshgasman has already properly answered, itís the ĎObject invalid or no longer setí runtime error.
    Iím sorry for the inconvenience , and I will remember to provide those details next time I ask something.

    Quote Originally Posted by Micron View Post
    You don't - you can do what I do much (not all) of the time. Read and move on. Same as when a whole lot of code gets pasted in without using code tags (not saying that happened here). Usually I won't bother to try and read it. Keeps me sane (ok, maybe keeps me from getting crazier).
    Ok Micron, here is some more code for your sanity. After following the link that Welshgasman provided it took me about 5 min. to fix the whole issue. The problem is solved by simply adding: "If Me.Dirty Then rsAttachments.Close" and I thank you all for your kind support.
    Code:
    Private Sub btnUserPic_Click()
    On Error GoTo Err_btnUserPic_Click
    Dim db As DAO.Database
        Dim rsContacts As DAO.Recordset2
        Dim rsAttachments As DAO.Recordset2
        Dim fldattachment As DAO.Field2
    
        Set db = CurrentDb
        Set rsContacts = Me.Recordset
    
        If Not rsContacts.EOF And Not rsContacts.BOF Then
            rsContacts.Edit
            Set fldattachment = rsContacts.Fields("Anlagen")
            Set rsAttachments = fldattachment.Value
            
            ' enable Add Mode for the form
            Me.AllowAdditions = True
    
            ' Activate edit mode.
            rsAttachments.AddNew
    
            ' Add the attachment.
            rsAttachments.Fields("FileData").LoadFromFile "\\Path\" & Me![Last Name] & " " & Me![First Name] & ".jpg"
            rsAttachments.Update
    
            ' Increment the counter.
            AddAttachment = AddAttachment + 1
    
            ' Save the changes to the parent record.
            rsContacts.Update
            
            ' If the form is dirty
            If Me.Dirty Then
            ' Close the child and parent recordsets.
            rsAttachments.Close
            rsContacts.Close
            End If
        End If
    
        Set fldattachment = Nothing
        Set rsAttachments = Nothing
        Set rsContacts = Nothing
        Set db = Nothing
        
    Exit_btnUserPic_Click:
        Exit Sub
    Err_btnUserPic_Click:
        MsgBox Err.Description
        Resume Exit_btnUserPic_Click
         
    End Sub

  8. #8
    Join Date
    Jan 2017
    Location
    Swansea,South Wales,UK
    Posts
    3,725
    Well I am surprised by that, as I would have thought you could quite happily close a recordset if it had not been updated?
    Even an attachment recordset?
    Please use # icon on toolbar when posting code snippets.
    Cross Posting: https://www.excelguru.ca/content.php?184
    Debugging Access: https://www.youtube.com/results?sear...bug+access+vba

  9. #9
    MXQ's Avatar
    MXQ is offline Novice
    Windows 10 Office 365
    Join Date
    Aug 2020
    Posts
    9

    Wink

    What an irony, dear Welshgasman. You provided the link that led me to the solution and now you are surprised by that.
    I hope you're fine and wish you a nice day my friend!

Please reply to this thread with any new information or opinions.

Similar Threads

  1. Replies: 1
    Last Post: 03-09-2022, 02:30 AM
  2. Replies: 5
    Last Post: 01-15-2017, 09:53 AM
  3. Replies: 1
    Last Post: 08-30-2011, 11:54 PM
  4. Attachment Picture
    By cggriggs in forum Forms
    Replies: 0
    Last Post: 06-14-2011, 10:17 AM
  5. Change a Picture in an Attachment
    By ksmith in forum Access
    Replies: 2
    Last Post: 08-18-2010, 11:17 AM

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  
Other Forums: Microsoft Office Forums