Email Drag & Drop VBA

[HillTJ]

Hi, I have adopted the following code & thank all whom have something to do with it & allow it to be publicly available. It's installed on an 'OnDirty' event of a control on a subform in datasheet view. All works well except that it will not allow an email to be dragged to a new record on the form. If i generate a new record, without closing the main form & reopening it it will not drag in. I get the "Circle with the slash through it" (whatever that's called). Is it some kind of refresh issue? Please see code following. Appreciate it.

Private Sub EmailMemo_Dirty(Cancel As Integer)

    'I got the guts of this sub from Remou on tek-tips.com. S/he told me I can drag and drop an
    'email to a memo field, then gave me the object control code to save the file.
    Dim olApp As Outlook.Application
    Dim olExp As Outlook.Explorer
    Dim olSel As Outlook.Selection
    Dim i, intCounter, intResponse As Integer
    Dim strFilename, strSQL, strFolderPath, strPathAndFile, strMsg As String
    Dim fs As Object
    Dim fsFolder As Object
    Dim blnFolderExists, blnFileExists As Boolean
    
    'This field is used to control attaching emails by dropping them on the field.
    'To allow this the field must be editable. This means the user could accidentally
    'type in the field and trigger the code to attach an email. Therefore, this user
    'verification makes sure the user intentionally dropped an email on the field.
    strMsg = "WARNING: You have triggered the E-mail Attachment Function. CHOOSE CAREFULLY ..." & vbCr & vbCr
    strMsg = strMsg & "If you intended to attach an e-mail to this note, answer Yes below. "
    strMsg = strMsg & "If you did not intend to attach an e-mail and don't know what's going on, "
    strMsg = strMsg & "answer No below." & vbCr & vbCr
    strMsg = strMsg & "Did you intentionally drag and drop an e-mail to attach it to this note?"
    intResponse = MsgBox(strMsg, vbYesNo)
    If intResponse = 7 Then 'No
        Cancel = True
        Exit Sub
    End If
    
    'My network consultant advises not putting too many files in a folder - like our Permanent Images.
    'Therefore, I will separate emails into a new folder each year. This code allows me
    'to never check on it, by creating the folder automatically when the year changes.
    Set fsFolder = CreateObject("Scripting.FileSystemObject")
    strFolderPath = "F:\Permanent Emails " & Year(Date)
    If fsFolder.FolderExists(strFolderPath) = False Then
        fsFolder.CreateFolder (strFolderPath)
    End If

    'Create the filename as a message file from the ClientID and the NoteID - which will be unique
    strFilename = Me.txtClientID & "_" & Me![SvcNoteID] & ".msg"
    
    'Combine for full path and file name
    strPathAndFile = strFolderPath & "" & strFilename
    
    'Make sure this file does not already exist to avoid overwriting email files when there is a
    'system glitch.
    Set fs = CreateObject("Scripting.FileSystemObject")
    blnFileExists = fs.FileExists(strPathAndFile)
    If blnFileExists = False Then
        'There's not already a file for this client and noteID. This is the way it always
        'should be. But stuff happens. So, I'm checking.
        'Save the email to the filename just created as a message file
        Set olApp = GetObject(, "Outlook.Application")  'First argument is blank to return the currently
                                                        'active Outlook object, otherwise runtime fails
        Set olExp = olApp.ActiveExplorer
        Set olSel = olExp.Selection
        For i = 1 To olSel.Count
            olSel.Item(1).SaveAs strPathAndFile, olMSG
        Next
    Else
        'There's already a file for this client and noteID. This should be impossible,
        'but stuff happens. In this case we notify the user and then re-establish the links
        'so the user can handle it.
        strMsg = "ATTENTION: The system detected an e-mail file already created for this note. "
        strMsg = strMsg & "That e-mail is now linked to this note ID. Please do the following:" & vbCr & vbCr
        strMsg = strMsg & "1. View the e-mail normally." & vbCr
        strMsg = strMsg & "2. If it is the correct e-mail, you don't need to do anything else." & vbCr
        strMsg = strMsg & "3. If it is the wrong e-mail, use the Un-Attach E-mail button to get rid of it. "
        strMsg = strMsg & "Then attach the correct e-mail."
        MsgBox strMsg
    End If
    
    'Update the location field with the location.
    Cancel = True   'To roll back changes caused by the drop.
    Me![EmailLocation] = strPathAndFile
    Me.EmailMemo = "EMAIL ATTACHED: Click Here To View"
    Me.EmailMemo.Locked = True
    Me.Dirty = False    'To save the changes.
    
    Set fsFolder = Nothing
    Set fs = Nothing
    Set olSel = Nothing
    Set olExp = Nothing
    Set olApp = Nothing
    
End Sub

 

[June7]

Could you edit post so code is between CODE tags and has proper indentation.

 

[HillTJ]

June7, another skill I've just learn't. Please see edited code @post#1. As always, thanks for your time. I really appreciate it

 

[Gasman]

I use this Smart Indenter for other people's code.

https://www.add-ins.com/macro-products-for-Microsoft-Excel/how-to-indent-vba-code/how-to-indent-vba-code.htm

HTH

 

[arnelgp]

I don't think access has drag&drop feature.

 

[GinaWhipp]

That circle with the line thru means *nope, can't do that*. This is because no drag and drop for Outlook mail.

 

[HillTJ]

Gina, i figure that too, but it works nicely. I have a sub form where i capture emails by dragging from outlook to an archive folder. Been doing it for a month now with hundreds of emails. The sub form is in data sheet view. The code allows me to drag to the first record fine, but shows the 'circle of death' when i try to do same on the next record. I' going to try me.refresh on the on current event of the sub form. Any other ideas? I work around it by closing then reopening the main form each time, but it's a bit tedious & not user friendly.

 

[GinaWhipp]

Hmm, I may have to play with that. I have never done that with Outlook because no drag and drop or so I thought.

 

[GinaWhipp]

Well, after a little research, I stand corrected, it can bed done. Never too old to learn something new.

 

[Gasman]

Well, after a little research, I stand corrected, it can bed done. Never too old to learn something new.

But does it happen with the second record. or any non current record.?

Does the record have to be current before it can accept the email.?

Not something I have ever done, but would love to know the outcome.

Edit:
It appears it does not.

However, @HillTJ, you have

Me.EmailMemo.Locked = True

in your code.

When does it get unlocked.?

 

[HillTJ]

Gasman, i don't unlock it. I guess it defaults to unlocked for the first record. Maybe you've got the answer! I'll try unlocking the control. Cheers

 

[Gasman]

Well I tried after locking the control and get the same result as you.

I *thought* you might have to select current record, but I was able to drag emails into new records without a problem.

Then when I looked at your code, I noticed that you lock the control after saving the file.?
So it will remain locked until you unlock it somewhere?, or exit the form and start all over again.

 

[HillTJ]

Gasman, how about an if statement @ the start of the function... if locked then unlock it? It seems such a useful routine to me & probably one that few are aware of?

 

[Gasman]

Gasman, how about an if statement @ the start of the function... if locked then unlock it? It seems such a useful routine to me & probably one that few are aware of?

Only you know what you are trying to achieve, but if you used an if statement to check if the control was not null and not "" then lock it, that would stop someone changing it?, but still allow you to add another email to another record as long as an email had not already been added?

If that is the actual cause of the problem, which from your first post I suspect it is, then work out what you want to do, now you know what is happening.?

HTH

 

[HillTJ]

Gasman, i commented out the line of code dealing with the record lock & now i can drag in multiple emails without having to save after each. Now i understand what that function does in the code. Will trial it that way for while to determine what other effects may gave occurred. Thanks.

 

[Gasman]

Well I can only presume the intention was not to allow the message/file to be changed after initial entry.?

 

[HillTJ]

Gasman, yes. Totally correct. I just have to figure how. Cheers.