Drag & Drop Email to Access - Possible? 2

[jhaganjr]

I may need professional help for this, but thought I'd start here ...

In our Access database we make notes of client activity. Some of that activity involves receiving email from and sending email to clients. We use Outlook. I want to save these emails and allow the user to link to them from the associated notes record.

This is easy enough with manual processes - i.e. save the email in msg format (or otherwise) to a network folder, put the path and filename in a field for the associated notes record, and on the form provide a button or hyperlink with code that opens the appropriate file. We do that now with scanned images and it works just fine.

However, that manual process takes time and leaves lots of room for user error. So ...

I'd like to allow the user to drag an email from Outlook and drop it on the open database form. (Picture how you can drag an email to the Outlook calendar to automatically create an appointment.) On the Access form, this action would then launch the code that saves the email, updates the record, and refreshes the form so the user sees the link/button ... and can now click that link/button and view the email - which is permanently stored on a network drive and linked to this specific notes record.

Any thoughts at all out there? Is it possible to drag and drop an email from Outlook to Access and trigger code?

Many thanks,
Joe

 

[Remou]

It is possible to drag and drop an email from both Outlook and Outlook Express to a memo field. A few notes:

Private Sub MemoMemo_AfterUpdate()
Dim olApp As Outlook.Application
Dim olExp As Outlook.Explorer
Dim olSel As Outlook.Selection
Dim i

Set olApp = GetObject("", "Outlook.Application")

Set olExp = olApp.ActiveExplorer
Set olSel = olExp.Selection
For i = 1 To olSel.Count
    MsgBox olSel.item(i).EntryID
    olSel.item(i).SaveAs CurrentProject.Path & "\mail.txt", olTXT
Next
End Sub

It may be more suitable to write the EntryID to the database and use it to retrieve the mail item.

 

[jhaganjr]

Thanks Remou!

I hadn't tried dropping on a memo field. And your code is perfect.

I think I can tweak it from here to do exactly what I want.

Joe

 

[Bill6868]

Could anyone explain how this code to works. I'm not having any luck with it. Would the text and all other information appear in the memo field, or just an Outlook email file icon.

Thanks

 

[Remou]

With Outlook Express, the entire email will appear in the textbox, with Outlook, only the header will appear. However, this is not the point of the code, the textbox is merely an object on which to hang code to copy an email from Outlook to a file that is then related to the customer record. You could do a good deal more with a little extra code, in that the ID of the Outlook email is returned.

 

[jhaganjr]

Bill6868,

Here's how I fleshed out Remou's code idea for my uses. I moved the code to the dirty event so it runs the instant the user drops the email onto the memo field.

What the code does is makes a copy of the email in a network folder. Instead saving as a text file I'm saving in msg format so it stays an email. This way we can open it from the database and reply to it. Plus attachments stay with it, which is great for our real-life needs.

When it's all done I put text in the memo field indicating an Email has been attached. The Click event of the field then launches code to open the linked email.

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

 

[mrbboy]

I tried this code but nothing happens when i drop the email into the memo field. It doesn't even create a new path for the email. Where can my error be?

rene

 

[Remou]

It is generally better to start a new thread. If your control is not bound, it will not have a Dirty event. Try the Change event.

 

[Techniproshop]

To Remou:

I tried your code in my memo field and got this message from the debugger:

Dim olApp As Outlook.Application

Compile error:
User-defined type not defined

Any idea? I'm using Access 2K

Thanks.

 

[Remou]

You need a reference to the Outlook library. Click Tools->References in the code window and tick Microsoft Outlook x Object Library.

 

[Techniproshop]

To jhaganjr:

I tried your code in my memo field. I dragged an email to the memo field and all I got is the header of the email. No file were saved on the network and no link is created to open the email. Any clue?

What will be the code "on clic" to the memo field?

Thanks.

 

[jhaganjr]

First, you're headed in the right direction. When I drag and drop an email onto my memo field all I get is the header of the email, too.

That's why I put my code in the Dirty event of the field - to trap that event and do what I want to do. Make sure you're using the On Dirty event of the field, NOT the form.

The code should launch when you drop the email. I suggest you put a break point in your code and watch it line by line to see what happens - to see where it fails.

At the very least you should be getting the first warning message as that is not system dependent in any way.

After that, the code is specific to my network and database elements. For example, I'm saving to my network F drive. Do you have an F drive to save to?

I'm referencing fields txtClientID, SvcNoteID, EmailLocation and EmailMemo. These are all fields specific to my underlying data tables, and I use the values in those fields to create unique filenames for the saved emails, and to store the filename in the database record. Are you using these database elements with the same names?

You must take the code and make it work for your system and setup by changing these values ... or making sure those exact field names exist in your underlying table and on your form.

If you want to test it exactly as I wrote it, create a table with those exact field names in it and base your form on that table. If it works that way, then you need to figure out how to adjust to make it work with your data.

Again, set a break point and watch the code line by line.

As for the Click event, here's the code ...

Private Sub EmailMemo_Click()
On Error GoTo Error_EmailMemo_Click

Dim strMsg As String

'To open an attached email if present.
If Me.EmailMemo = "EMAIL ATTACHED: Click Here To View" Then
'Make sure the EmailLocation field contains a value.
If IsNull(Me![EmailLocation]) Then
strMsg = "WARNING! PRINT SCREEN THIS ERROR MESSAGE FOR THE SYSTEM ADMINISTRATOR!" & vbCr & vbCr
strMsg = strMsg & "Note ID " & Me.SvcNoteID & " indicates an e-mail is attached. However, "
strMsg = strMsg & "the EmailLocation field is null." & vbCr & vbCr
strMsg = strMsg & "The attached e-mail is missing."
MsgBox strMsg
Else
Application.FollowHyperlink Me![EmailLocation]
End If
Else
'Do nothing
End If

Exit_EmailMemo_Click:
Exit Sub

Error_EmailMemo_Click:
If Err.Number = 16388 Then
'Ignore it - the user selected Cancel on the popup
ElseIf Err.Number = 490 Then
'The file specified filename does not exist. Notify the user.
strMsg = "WARNING! PRINT SCREEN THIS ERROR MESSAGE FOR THE SYSTEM ADMINISTRATOR!" & vbCr & vbCr
strMsg = strMsg & "Note ID " & Me.SvcNoteID & " includes a value in EmailLocation of "
strMsg = strMsg & Me![EmailLocation] & ", but the file does not exist." & vbCr & vbCr
strMsg = strMsg & "The attached e-mail is missing."
MsgBox strMsg
Else
MsgBox Err.Number & " " & Err.Description
End If
Resume Exit_EmailMemo_Click

End Sub