前回は、各デバイスに保管庫となる『Obsidian』というフォルダを作成し、OneDrive と Android 端末の間で同期を取ってくれる『OneSync』の設定をしたところまで書きました。
今回は、最初に使用していたノートアプリである『Evernote』の頃から溜め込んできた10年分の日記をどうするか…というのが題材です。
まぁ、どうするかも何も、Obsidian に持っていきたい。
…といっても、そこまでの熱量ではないですけど…まー移行できたらいいなー、くらいの感じです。
検索すると、OneNote から Obsidian にファイルを移すアプリ的なものはあるようです。
…が、なんかうまく動いてくれなかったんです。
困ったなー、と思っていたんですが、ここで思い出したのが Obsidian は『Markdown形式』だったということ。
Markdown 形式はほぼテキスト形式なので(私の理解では…)、テキスト形式にしたあと拡張子を『*.md』に変えればいいのでは…? と思いつきました。
(太字とか斜線とか、そういう装飾を使用しない前提です)
で、実際にテキトーなテキストファイルを作成し、拡張子を『*.md』に変更して Obsidian に渡したところ、ちゃんと読み取ってくれました。
というわけで、これでやろうと思いました。
まず、OneNote から、どんな形式でもいいのでドバっとデータを吐き出します。
私の日記は1日1ノートで作成し、タイトルが日付になっています。
最初から細かく1日ごとにエクスポートできればそれでいいんですが、どうやらそれは難しそうでした。
ノートブックを年単位(『2025』など)にしていて、ノートブック単位でエクスポートできそうなので、『Word 文書』『PDF』『単一ファイル Web ページ』なんでもいいので吐き出してもらいます。
文字さえ貰えれば、あとはなんとでもできます。
私の場合は、Excelの2列目(B 列)にその日記を貼りました。
OneNote ではタイトルが日付だったんですが、その日付も全部込みで2列目にペタっと貼ります。
で、フィルタなり何なりを駆使して、日付の書かれたセルの1列目(A 列)に『1』とフラグを立てます。
そうしてから、以下のマクロを実行すると、『1』が立っている行から次の『1』が立っている行の1つ上(最終行の場合はそこまで)を、最初の『1』が書かれている日付をファイル名として UTF-8 の『*.md』形式で保存します。(例: 2025-06-17.md)
Sub ExportToMarkdown()
Dim ws As Worksheet
Dim lastRow As Long, i As Long, j As Long
Dim saveFolder As String
Dim fileName As String
Dim startRow As Long, endRow As Long
Dim dateValue As Variant
Dim textContent As String
Dim stream As Object ' ADODB.Stream
' シートの設定
Set ws = ActiveSheet
lastRow = ws.Cells(ws.Rows.Count, 2).End(xlUp).Row
' フォルダ選択ダイアログ
With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "保存するフォルダを選択してください"
If .Show = -1 Then
saveFolder = .SelectedItems(1)
Else
MsgBox "フォルダが選択されませんでした。処理を終了します。", vbExclamation
Exit Sub
End If
End With
' フラグの行をループ
For i = 1 To lastRow
If ws.Cells(i, 1).Value = 1 Then
startRow = i
dateValue = ws.Cells(i, 2).Value
' 次のフラグ行を探す
endRow = lastRow
For j = i + 1 To lastRow
If ws.Cells(j, 1).Value = 1 Then
endRow = j - 1
Exit For
End If
Next j
' 2列目の文字列を取得
textContent = ""
For j = startRow + 1 To endRow
textContent = textContent & ws.Cells(j, 2).Value & vbCrLf
Next j
' ファイル名作成 (YYYY-MM-DD.md)
fileName = saveFolder & "\" & Format(dateValue, "yyyy-mm-dd") & ".md"
' ADODB.Stream を使用して UTF-8 で書き込み
Set stream = CreateObject("ADODB.Stream")
With stream
.Type = 2 ' テキストデータ
.Charset = "UTF-8" ' UTF-8 エンコーディング
.Open
.WriteText textContent
.SaveToFile fileName, 2 ' 上書き保存
.Close
End With
Set stream = Nothing
NextFlag:
End If
Next i
MsgBox "処理が完了しました。", vbInformation
End Subこれは、ChatGPT にお願いして書いてもらいました。
最初自分で1からつくろうかと思ったんですが「めんどくさい…」と思ってしまい、たたき台を ChatGPT に作ってもらって、それを自分で使いやすいように少し直した感じです。
ササッと作ってくれて助かりますよね…。
ちなみに、ファイル名として用いる日付が実在するものなのかは判定していません。
OneNote で作成するとき、Integromat(現・Make)に「毎日朝5時にその日の日付のノートを作る」という作業をやってもらっていたので、日付自体は存在することが確かだったためです。
次に、なんとなく気持ちが悪いので、タイムスタンプも修正してもらうことにしました。
選択したフォルダに入っている『*.md』ファイルの『作成日時』のタイムスタンプを、ファイル名になっている日付の朝5時にするマクロです。
Option Explicit
#If VBA7 Then
Private Declare PtrSafe Function SetFileTime Lib "kernel32.dll" ( _
ByVal hFile As LongPtr, _
ByRef lpCreationTime As Any, _
ByRef lpLastAccessTime As Any, _
ByRef lpLastWriteTime As Any) As Long
Private Declare PtrSafe Function CreateFile Lib "kernel32.dll" Alias "CreateFileA" ( _
ByVal lpFileName As String, _
ByVal dwDesiredAccess As Long, _
ByVal dwShareMode As Long, _
ByVal lpSecurityAttributes As Long, _
ByVal dwCreationDisposition As Long, _
ByVal dwFlagsAndAttributes As Long, _
ByVal hTemplateFile As Long) As LongPtr
Private Declare PtrSafe Function CloseHandle Lib "kernel32.dll" (ByVal hObject As LongPtr) As Long
#End If
Function SelectFolder() As String
Dim fd As FileDialog
Dim folderPath As String
Set fd = Application.FileDialog(msoFileDialogFolderPicker)
With fd
.Title = "処理対象のフォルダを選択してください"
.AllowMultiSelect = False
.InitialFileName = "C:\"
If .Show = -1 Then
folderPath = .SelectedItems(1)
Else
folderPath = ""
End If
End With
Set fd = Nothing
SelectFolder = folderPath
End Function
Sub ChangeFileCreationTime()
Dim folderPath As String
Dim fileName As String
Dim filePath As String
Dim file As Object
Dim fs As Object
Dim match As Object
Dim regex As Object
Dim hFile As LongPtr
Dim originalDate As Date
Dim utcDate As Date
Dim fileTime As Double ' **Double で計算**
Dim fileTimeLL As LongLong ' **64ビット整数**
Dim lowDateTime As LongPtr
Dim highDateTime As LongPtr
folderPath = SelectFolder()
If folderPath = "" Then Exit Sub
Set regex = CreateObject("VBScript.RegExp")
regex.Pattern = "(\d{4})-(\d{2})-(\d{2})\.md$"
regex.IgnoreCase = True
regex.Global = False
Set fs = CreateObject("Scripting.FileSystemObject")
Dim folder As Object
Set folder = fs.GetFolder(folderPath)
For Each file In folder.Files
fileName = file.Name
If regex.Test(fileName) Then
Set match = regex.Execute(fileName)(0)
' **VBAで日付を処理**
originalDate = DateSerial(CInt(match.SubMatches(0)), CInt(match.SubMatches(1)), CInt(match.SubMatches(2)))
' **UTC変換 (JST 5:00 → UTC 20:00)**
utcDate = DateAdd("h", -9, originalDate + TimeSerial(5, 0, 0))
' **FILETIMEの計算 (100ナノ秒単位)**
fileTime = (utcDate - #1/1/1601#) * 86400 * 10000000#
' **LongLong に変換**
fileTimeLL = CLngLng(fileTime)
' **FILETIMEを分解 (Windows APIが要求する形式)**
lowDateTime = fileTimeLL And &HFFFFFFFF
highDateTime = (fileTimeLL \ 4294967296#) And &HFFFFFFFF
' **デバッグ出力**
Debug.Print "Before SetFileTime → 年: " & Year(originalDate) & ", 月: " & Month(originalDate) & ", 日: " & Day(originalDate)
Debug.Print "変換後 (UTC) → 年: " & Year(utcDate) & ", 月: " & Month(utcDate) & ", 日: " & Day(utcDate)
filePath = folderPath & "\" & fileName
hFile = CreateFile(filePath, &H40000000, 0, 0, 3, &H80, 0)
If hFile <> -1 Then
' **作成日時のみ変更**
If SetFileTime(hFile, lowDateTime, ByVal 0&, ByVal 0&) <> 0 Then
Debug.Print "変更成功: " & filePath
Debug.Print "確認: " & Format(FileDateTime(filePath), "yyyy-mm-dd HH:nn:ss")
Else
Debug.Print "変更失敗: " & filePath
End If
CloseHandle hFile
End If
End If
Next
Set regex = Nothing
Set fs = Nothing
Set folder = Nothing
MsgBox "処理が完了しました", vbInformation
End Subこれはなかなか苦労していたみたいです(他人事)。
なかなかうまく時間が変更できなかったみたいです(他人事)。
私なんぞのレベルでは、すでに何をしているかもよくわかっていません。
でも、ちゃんとタイムスタンプが代わったからいいんだと思います。
これで、日記を1日1ノートにして、タイムスタンプもきれいになりました。
よかったよかった。
あとは年ごとのフォルダに入れて Obsidian に読み込ませれば、10年分の日記の移行の完了です。
次は『テンプレート』や『プラグイン』について書かせてください。
コメント