Could you please provide a link to the VBA script you are trying to implement? In your previous post "copies Outlook Contacts into OneNote" is underlined, but it does not work as a link for me
If you mean the text "I need the Object Library to run a VBA script that
copies Outlook Contacts into OneNote", that isn't a link--it's just underlined text. (Because my post #X is fairly detailed I took care to color the link so it appeared as in Windows. I should have done this for all the post's active links. Sorry.)
Or insert the VBA code in your reply
More about 'why' the Outlook-to-OneNote transfer is so important
My Outlook Contacts
Notes field depends completely on the text appearing the way I formatted it in Outlook. Because OneNote’s API doesn’t accept raw RTF—but does accept HTML, this routine transfers the formatted Notes content BodyFormat as HTML.
More about 'why' go the VBA route
Before going the VBA route, to prove to myself this could be done I manually cut-and-pasted each of the Outlook Contact fields into their corresponding OneNote field. I was thrilled to find I could cut/paste fully formatted (RTF-like) information from the Contact Notes field into the corresponding OneNote Notes field.
I might have used the manual cut/paste approach if I only had a couple hundred Contacts but doing 1700 seemed a bit daunting.
Sub SendAllContactsToOneNote()
Dim olApp As Outlook.Application
Dim olNamespace As Outlook.Namespace
Dim olFolder As Outlook.Folder
Dim olContact As Outlook.ContactItem
Dim oneNoteApp As OneNote.Application
Dim sectionID As String
Dim contactHTML As String
Dim contactName As String
Dim notesFormatted As String
Dim i As Long
' Initialize Outlook
Set olApp = Outlook.Application
Set olNamespace = olApp.GetNamespace("MAPI")
Set olFolder = olNamespace.GetDefaultFolder(olFolderContacts)
' Initialize OneNote
Set oneNoteApp = New OneNote.Application
sectionID = GetSectionID(oneNoteApp, "Contact_OneNote", "VBA transfer")
If sectionID = "" Then
MsgBox "Target OneNote section not found.", vbCritical
Exit Sub
End If
' Loop through all items in Contacts
For i = 1 To olFolder.Items.Count
If TypeOf olFolder.Items(i) Is Outlook.ContactItem Then
Set olContact = olFolder.Items(i)
contactName = olContact.FullName
' Get Notes (HTML preferred)
If olContact.BodyFormat = olFormatHTML Then
notesFormatted = olContact.HTMLBody
Else
notesFormatted = "<pre>" & olContact.Body & "</pre>"
End If
' Build HTML
contactHTML = "<html><head><title>" & contactName & "</title></head><body>" & _
"<h1>" & contactName & "</h1>" & _
"<p><b>Company:</b> " & olContact.CompanyName & "<br>" & _
"<b>Email:</b> " & olContact.Email1Address & "<br>" & _
"<b>Phone:</b> " & olContact.BusinessTelephoneNumber & "<br>" & _
"<b>Mobile:</b> " & olContact.MobileTelephoneNumber & "<br>" & _
"<b>Address:</b> " & olContact.MailingAddress & "</p>" & _
"<hr><h3>Notes</h3>" & notesFormatted & _
"</body></html>"
' Create OneNote Page
Dim pageID As String
oneNoteApp.CreateNewPage sectionID, pageID, npsDefault
oneNoteApp.UpdatePageContent "<one
age xmlns
ne='
http://schemas.microsoft.com/office/onenote/2013/onenote' ID='" & pageID & "'>" & _
"<one:Outline><one:OEChildren>" & _
"<one:OE><one:HTMLBlock><![CDATA[" & contactHTML & "]]></one:HTMLBlock></one:OE>" & _
"</one:OEChildren></one:Outline></one
age>"
End If
Next i
MsgBox "All Outlook contacts sent to OneNote.", vbInformation
End Sub
The following supporting function GetSectionID() is essential because it finds the unique internal ID of the OneNote section where you want to send the contact(s). OneNote doesn't let you create or update pages by just using the section name — it requires a section ID, which looks something like this: {D5E8F0D0-2F0E-4977-9CB9-C0143D2D0A9F}{1}{B0}
More specifically:
Function GetSectionID
• Looks for the specified
notebook and section by name.
• If the section
doesn't exist, it creates it inside the target notebook.
• Returns the resulting
section ID (whether found or created).
Function GetSectionID(oneNoteApp As OneNote.Application, notebookName As String, sectionName As String) As String
Dim xml As String
oneNoteApp.GetHierarchy "", hsSections, xml
Dim doc As Object
Set doc = CreateObject("MSXML2.DOMDocument.6.0")
doc.LoadXML xml
Dim nsMgr As Object
Set nsMgr = CreateObject("MSXML2.DOMDocument").createNamespaceManager(doc)
nsMgr.AddNamespace "one",
http://schemas.microsoft.com/office/onenote/2013/onenote
Dim notebookNode As Object
Set notebookNode = Nothing
Dim node As Object
For Each node In doc.SelectNodes("//one:Notebook")
If node.Attributes.getNamedItem("name").Text = notebookName Then
Set notebookNode = node
Exit For
End If
Next
If notebookNode Is Nothing Then
MsgBox "Notebook '" & notebookName & "' not found.", vbCritical
GetSectionID = ""
Exit Function
End If
' Look for the section within the notebook
For Each node In notebookNode.ChildNodes
If node.BaseName = "Section" Then
If node.Attributes.getNamedItem("name").Text = sectionName Then
GetSectionID = node.Attributes.getNamedItem("ID").Text
Exit Function
End If
End If
Next
' Section not found – create it
Dim newSectionID As String
oneNoteApp.CreateNewSection notebookNode.Attributes.getNamedItem("ID").Text, sectionName, newSectionID
GetSectionID = newSectionID
End Function
Thanks greatly.
(required for OneNote automation via VBA)
