PDA

View Full Version : Moving Email to Outlook Journal



SoudeDia
2020-04-15, 11:57 AM
Hi,
I'm not sure if anyone is still utilizing the journal functionality of Outlook anymore, but I used to find it very useful.

I stopped using it for awhile and now regretting it, which is the reason for this sadly desperate post.

I can individually move / copy email (including any attachments if applicable) to journal by dragging them one at a time so the subject line appears within journal.

Or

I can mass move email to journal when all email is lumped together in one entry - no subject which is pretty useless to me.

Can anyone figure out how I can move more than 3000 email into journal from my inbox so that the subject appears, the attachments are there and it's as if they were imported individually?

I don't know if this can be made automatic any longer, but I'll take that answer also if you've got it!!

Thanks in advance. I'm very grateful.

NormS
2020-04-22, 07:51 PM
It looks like there's some VBA code here that might do it

https://blog.cwew.co/2018/02/outlook-vba-macros-for-journal-entries.html

NormS
2020-04-23, 01:47 AM
I added some code of my own to loop through a folder of emails. It's set up to transfer 5 emails just for testing. If that works then set MaxItems to 3000 and let it fly!


Option Explicit
Const MaxItems As Integer = 5 'limit number of items during testing


Sub CopyEmailsToJournal()
'
' loop through emails, copying to the journal
'
' This will copy from default inbox to the default journal
' modify the "set olFolder" and "set JournalFolder" lines in the two routines
' to use different source and destination folders
'
Dim objNS As Outlook.NameSpace: Set objNS = GetNamespace("MAPI")
Dim olFolder As Outlook.MAPIFolder
Set olFolder = objNS.GetDefaultFolder(olFolderInbox) '.Folders("Subfolder").Folders("Subsubfolder")
' or if the email account is not the default
'Set olFolder = objNS.Folders("someone@somewhere.net").Folders("Inbox").Folders("Subfolder")
Dim Item As Object
Dim i As Integer, stop_after As Integer


i = 1


For Each Item In olFolder.Items
If TypeOf Item Is Outlook.MailItem Then
Dim oMail As Outlook.MailItem: Set oMail = Item
oMail.Display
CreateJournalFromEmail
oMail.Close olSave
Debug.Print oMail.SenderEmailAddress
i = i + 1
End If
If i > MaxItems Then Exit Sub
Next


End Sub




Public Sub CreateJournalFromEmail()
'The third macro creates a new journal entry from an email. it takes the body of the E-Mail, appends it to the bottom of the new journal entry, and adds a time stamp. it will carry over any categories from the E-Mail, and set the company as what you set down below.
Dim CurrentEmail As Outlook.MailItem, oInspector As Inspector, JournalFolder As Folder, CurrentEmailName As String, newBody As String
Dim CurrentEmailCategories As String, CurrentEmailBody As String
Dim JournalItems As Object, newJournalEntry As Outlook.JournalItem

Set oInspector = Application.ActiveInspector
If oInspector Is Nothing Then
MsgBox "No active inspector"
Else
Set CurrentEmail = oInspector.CurrentItem
CurrentEmailName = CurrentEmail.Subject
CurrentEmailCategories = CurrentEmail.Categories
CurrentEmailBody = CurrentEmail.Body
Set JournalFolder = Session.GetDefaultFolder(olFolderJournal)
' can do this if not the default email account
'Set JournalFolder = Session.Folders("someone@somewhere.net").Folders(olFolderJournal)
Set JournalItems = JournalFolder.Items
Set newJournalEntry = JournalItems.Add("ipm.activity")
newBody = Chr(10) & Chr(10) & "New entry created from E-Mail at " & Now & Chr(10) & "Old Entry was: " & Chr(10) & "----------------" & Chr(10) & CurrentEmailBody
newJournalEntry.Subject = CurrentEmailName
newJournalEntry.Companies = "YOUR COMPANY"
newJournalEntry.Type = "Email Message"
newJournalEntry.Categories = CurrentEmailCategories
newJournalEntry.Body = newBody
newJournalEntry.Display
newJournalEntry.StartTimer
newJournalEntry.StopTimer
' place the email on the timeline when it was received
newJournalEntry.Start = CurrentEmail.CreationTime
newJournalEntry.Close olSave
End If
End Sub

NormS
2020-04-23, 02:24 AM
After some further testing it looks like the code above doesn't copy the attachments.

SoudeDia
2020-04-23, 02:51 AM
After some further testing it looks like the code above doesn't copy the attachments.


Maybe I could look for something that does that separately. but I'm goin to try this as soon as I get to my desk. thank you!

NormS
2020-04-23, 01:52 PM
This version will place the email in the journal entry. If you want to add the body text of the email you'll need to uncomment the "newJournalEntry.Body = newBody" statement in the second routine.


Option Explicit
Const MaxItems As Integer = 5 'limit number of items during testing


Sub CopyEmailsToJournal()
'
' loop through emails, copying to the journal
'
' This will copy from default inbox to the default journal
' modify the "set olFolder" and "set JournalFolder" lines in the two routines
' to use different source and destination folders
'
Dim objNS As Outlook.NameSpace: Set objNS = GetNamespace("MAPI")
Dim olFolder As Outlook.MAPIFolder
Set olFolder = objNS.GetDefaultFolder(olFolderInbox) '.Folders("Subfolder").Folders("Subsubfolder")
' or if the email account is not the default
'Set olFolder = objNS.Folders("someone@somewhere.net").Folders("Inbox").Folders("Subfolder")
Dim Item As Object
Dim i As Integer, stop_after As Integer


i = 1


For Each Item In olFolder.Items
If TypeOf Item Is Outlook.MailItem Then
Dim oMail As Outlook.MailItem: Set oMail = Item
oMail.Display
CreateJournalFromEmail
oMail.Close olSave
Debug.Print oMail.SenderEmailAddress
i = i + 1
End If
If i > MaxItems Then Exit Sub
Next


End Sub




Public Sub CreateJournalFromEmail()
'The third macro creates a new journal entry from an email. it attaches the E-Mail to the new journal entry, and adds a time stamp. it will carry over any categories from the E-Mail, and set the company as what you set down below.
Dim CurrentEmail As Outlook.MailItem, oInspector As Inspector, JournalFolder As Folder, CurrentEmailName As String, newBody As String
Dim CurrentEmailCategories As String, CurrentEmailBody As String
Dim JournalItems As Object, newJournalEntry As Outlook.JournalItem

Set oInspector = Application.ActiveInspector
If oInspector Is Nothing Then
MsgBox "No active inspector"
Else
Set CurrentEmail = oInspector.CurrentItem
CurrentEmailName = CurrentEmail.Subject
CurrentEmailCategories = CurrentEmail.Categories
CurrentEmailBody = CurrentEmail.Body
Set JournalFolder = Session.GetDefaultFolder(olFolderJournal)
' can do this if not the default email account
'Set JournalFolder = Session.Folders("someone@somewhere.net").Folders(olFolderJournal)
Set JournalItems = JournalFolder.Items
Set newJournalEntry = JournalItems.Add("ipm.activity")
newBody = Chr(10) & Chr(10) & "New entry created from E-Mail at " & Now & Chr(10) & "Old Entry was: " & Chr(10) & "----------------" & Chr(10) & CurrentEmailBody
newJournalEntry.Subject = CurrentEmailName
newJournalEntry.Companies = "YOUR COMPANY"
newJournalEntry.Type = "Email Message"
newJournalEntry.Categories = CurrentEmailCategories
newJournalEntry.Display
newJournalEntry.StartTimer
newJournalEntry.StopTimer
' place the email on the timeline when it was received
newJournalEntry.Start = CurrentEmail.CreationTime
' add the body of the email and attach it
'newJournalEntry.Body = newBody
newJournalEntry.Attachments.Add CurrentEmail, olEmbeddeditem
newJournalEntry.Close olSave
End If
End Sub

SoudeDia
2020-04-23, 02:04 PM
Maybe I could look for something that does that separately. but I'm goin to try this as soon as I get to my desk. thank you!

Well, my friend, I am sitting here watching magic happen. Thank you so very much. You are a lifesaver. Do you know of a site that may have some Outlook vba tools I am able to search? There are one or two things I'd like to search for, but little come up.

I haven't looks to see if this duplicates when I run it - did you notice? Or how can I get messages to automatically log into journal when I received?

I hope you have the very best day - so far, it looks like you've made mine.

NormS
2020-04-23, 02:48 PM
That's terrific, glad that it's working for you. If run again, yes it will create duplicate journal entries. When this happened during my testing I displayed the journal as a list, selected all the entries and deleted them.

I found, but haven't tried, this code that creates a journal entry when you open an email. Also pops up a message telling you how much time you spent reading it!

https://www.datanumen.com/blogs/auto-track-time-spend-email-outlook-journal/