Option Explicit
Option Base 0
'
'【メモ】ツール(T)>参照設定(R）に
' Microsoft OneNote xx.x Object Labrary
' Microsoft XML vx.x
' のライブラリーにチェックを入れる。
'
'*スリープＡＰＩ
Private Declare PtrSafe Sub Sleep Lib "KERNEL32.dll" (ByVal dwMillisconds As Long)
'
'
Public Sub OneNoteページ追加サンプルマクロ()
Dim objExec As Object, appOne As OneNote.Application
Dim strSecI As String, strHie As String
Dim domDocu As DOMDocument60, objElem As Object
Dim intPgCn As Integer
Dim strPgId As String, strPage As String
'OneNoteプログラム起動
Set objExec = CreateObject("WScript.Shell").Exec("ONENOTE.EXE")
Sleep (1500)
'
'OneNoteオブジェクト設定
Set appOne = VBA.CreateObject("OneNote.Application")
If Trim(appOne.Windows.CurrentWindow.CurrentPageId) = "" Then
'カレントページ取得できなければ、終了!
objExec.Terminate: Set objExec = Nothing
Exit Sub
End If
'セクションＩＤ取得
strSecI = appOne.Windows.CurrentWindow.CurrentSectionId
'
'ノード階層構造を取得
appOne.GetHierarchy strSecI, OneNote.HierarchyScope.hsPages, strHie
'
'DOMDocument設定
Set domDocu = New MSXML2.DOMDocument60
'
'ＸＭＬデータ読込み
If domDocu.LoadXML(strHie) Then
'最終のページＩＤ取得
intPgCn = domDocu.getElementsByTagName("one:Page").Length
Set objElem = domDocu.getElementsByTagName("one:Page").Item(intPgCn - 1)
strPgId = objElem.Attributes.getNamedItem("ID").NodeValue
'新しいページを追加
appOne.CreateNewPage strSecI, strPgId
'
'ノード階層構造を再取得
appOne.GetHierarchy strSecI, OneNote.HierarchyScope.hsPages, strHie
If domDocu.LoadXML(strHie) Then
'最終のページＩＤ再取得 ＝ 追加したページＩＤ
intPgCn = domDocu.getElementsByTagName("one:Page").Length
Set objElem = domDocu.getElementsByTagName("one:Page").Item(intPgCn - 1)
strPgId = objElem.Attributes.getNamedItem("ID").NodeValue
'追加したページに、タイトルと本文を書き加える
appOne.UpdatePageContent OneNote追加ページタイトル部分(strPgId)
Sleep (500)
appOne.UpdatePageContent OneNote追加ページ本文部分(strPgId)
Sleep (500)
End If
Else
MsgBox ("OneNoteのＸＭＬデータ読込みエラー")
End If
'OneNoteオブジェクト解放
Set appOne = Nothing
'OneNoteプログラム終了
objExec.Terminate
Set objExec = Nothing
End Sub
'********************************************************
' 関数:OneNote追加ページタイトル部分
'********************************************************
Private Function OneNote追加ページタイトル部分(pstrPgId As String) As String
Dim strData As String
'
strData = "<?xml version=""1.0""?>" & vbCrLf
strData = strData & "<one:Page xmlns:one=""?????"" " '←不正文字ゆえ省略
strData = strData & "ID=""" & pstrPgId & """ "
strData = strData & " dateTime=""2024-12-31T15:00:00.000Z"" "
strData = strData & ">"
'
strData = strData & "<one:Title lang=""ja"">"
strData = strData & "<one:OE style=""font-family:'Meiryo UI';font-size:16.0pt"">"
strData = strData & "<one:T><![CDATA[追加したページ" & "]]></one:T> "
strData = strData & "</one:OE>"
strData = strData & "</one:Title>"
strData = strData & "</one:Page>"
'
OneNote追加ページタイトル部分 = strData
End Function
'******************************************************
' 関数:OneNote追加ページ本文部分
'******************************************************
Private Function OneNote追加ページ本文部分(pstrPgId As String) As String
Dim strData As String
strData = "<?xml version=""1.0""?>" & vbCrLf
strData = strData & "<one:Page xmlns:one=""?????"" " '←不正文字ゆえ省略
strData = strData & "ID=""" & pstrPgId & """>"
'
strData = strData & "<one:Outline >"
strData = strData & "<one:Position x=""30.0"" y=""80.0"" z=""0"" />"
strData = strData & "<one:Size width=""200.0"" height=""50.0"" />"
strData = strData & "<one:OEChildren>"
strData = strData & "<one:OE style=""font-family:'Meiryo UI';font-size:14.0pt"">"
strData = strData & "<one:T><![CDATA[追加したページの１行目]]></one:T>"
strData = strData & "</one:OE>"
strData = strData & "<one:OE style=""font-family:'Meiryo UI';font-size:14.0pt"">"
strData = strData & "<one:T><![CDATA[<p><b>追加したページの２行目</b></p>]]></one:T>"
strData = strData & "</one:OE>"
strData = strData & "</one:OEChildren>"
strData = strData & "</one:Outline>"
strData = strData & "</one:Page>"
'
OneNote追加ページ本文部分 = strData
End Function
