Moving Email to Outlook Journal

[SoudeDia]

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]

It looks like there's some VBA code here that might do it

https://blog.cwew.co/2018/02/outlook...l-entries.html

[NormS]

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]

After some further testing it looks like the code above doesn't copy the attachments.

[SoudeDia]

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]

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]

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]

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...tlook-journal/