Help with AfterUpdate event to add Outlook Attachment to Hyperlink field

[gojets1721]

Hello. Bit of a unique/challenging question. I have looked for some answers online but can't find anything. This might be a bit too specific of an issue.

I have a Hyperlink control in my form to allow users to drag a file from a File Explorer onto the control and it saves that file in a designated shared folder. It works great.

The issue is that it does not work if you drag a file attachment from Outlook. Nothing is added to the control. I use the below AfterUpdate code in the hyperlink control to achieve the above.

Any suggestions on if this can be tweaked to allow files to be dragged from Outlook?

Private Sub txtHyperLinkIN_AfterUpdate()

    Dim strInPath As String
    Dim strFileName As String
    Dim strFileFolder As String
    Dim strOutPath As String
    Dim strReportNumber As String
    Dim strTempFileName As String
    Dim strFileExt As String
    
    DoCmd.SetWarnings False
    
    strFileFolder = "\Assets\Attachments\"  'specify the output folder
    
    strInPath = Me!txtHyperLinkIN.Hyperlink.Address
    
    strReportNumber = Me.ID
    strTempFileName = strReportNumber & " - " & Format(Now, "yyyymmddhhmmss")
    
    If Len(strInPath) > 0 Then
        strFileName = Right(strInPath, Len(strInPath) - InStrRev(strInPath, "\"))  'get the file name
        strFileExt = Right(strFileName, Len(strFileName) - InStrRev(strFileName, ".") + 1) ' get the file extension with dot
    
    'build the new path with output folder path and record number and date and extension
            strFileFolder = strFileFolder & strTempFileName & strFileExt
    
        FileCopy strInPath, strFileFolder
    
        Me!HyperLinkOUT = "#" & strFileFolder & "#"
        
End Sub

 

[gojets1721]

I Asked Chat GPT:-

Uncle Gizmo
could you reformat both code blocks in to something i can cut and paste in to my form module?

ChatGPT
Sure, here is how you can incorporate the sample code into your existing Access VBA code. I'm including code to get the file name from Outlook, build a new path, and copy the file to a new location, similar to what your original code does:

'VBA
Private Sub txtHyperLinkIN_AfterUpdate()

    Dim objOutlook As Outlook.Application
    Dim objNamespace As Outlook.Namespace
    Dim objMail As Outlook.MailItem
    Dim objAttachments As Outlook.Attachments

    Dim strFileFolder As String
    Dim strOutPath As String
    Dim strReportNumber As String
    Dim strTempFileName As String
    Dim strFileExt As String
   
    strFileFolder = "\Assets\Attachments\"  'specify the output folder
    strReportNumber = Me.ID
    strTempFileName = strReportNumber & " - " & Format(Now, "yyyymmddhhmmss")
   
    ' Get a reference to Outlook
    Set objOutlook = CreateObject("Outlook.Application")
    Set objNamespace = objOutlook.GetNamespace("MAPI")

    ' Select a mail item
    On Error Resume Next
    Set objMail = objOutlook.ActiveExplorer.Selection.Item(1)
    On Error GoTo 0

    ' If a mail item is selected
    If Not objMail Is Nothing Then
        Set objAttachments = objMail.Attachments

        ' Loop over the attachments and save them
        For i = 1 To objAttachments.Count
            Dim strFileName As String
            strFileName = objAttachments.Item(i).FileName
           
            strFileExt = Right(strFileName, Len(strFileName) - InStrRev(strFileName, ".") + 1) ' get the file extension with dot
            'build the new path with output folder path and record number and date and extension
            strFileFolder = strFileFolder & strTempFileName & strFileExt
           
            objAttachments.Item(i).SaveAsFile strFileFolder
           
            Me!HyperLinkOUT = "#" & strFileFolder & "#"
        Next i
    End If

    'Clean up
    Set objAttachments = Nothing
    Set objMail = Nothing
    Set objNamespace = Nothing
    Set objOutlook = Nothing
End Sub

This code will now attempt to handle files dropped from Outlook in addition to files from File Explorer. When a file is dropped from File Explorer, your existing code will run. When a file is dropped from Outlook, the newly added code will attempt to save the file to disk.

Remember to add a reference to the Microsoft Outlook Object Library by going to Tools -> References in the VBA editor.

Please note, this is a basic solution and may not cover all edge cases. You should further modify and expand this to suit your exact needs. Don't forget to handle errors and edge cases such as when Outlook isn't open, the selected item isn't a mail item, there are no attachments, or if the file can't be saved for some reason.

THank you! So I tried this combined suggestion. The 'drag and drop' from file explorer still works but nothing happens when dragging over from Outlook. I can connect with ChatGPT to dive more into it unless you have any suggestions

 

[gojets1721]

Maybe try the separate code segments individually and see if they work ok. It might give you an idea where the issue lies...

I was able to figure it out. The code is written as if it were a command, rather than a drag and drop situation, which honestly works better. Thanks so much. This has been eye opening to me in terms of how useful ChatGPT can be! Thanks again!