EXCEL VBAコミュのMIxi日記のセーブマクロ

Excel VBA は、開発環境等面倒でないので、便利に使わせてもらっています。ちょっとした自動化とか、ツールを作るのには非常に便利です。
ああ、コミュニティがきっとある筈とさっき気づいて見つけて早速、メンバーにさせてもらいました。新参者ですが、どうぞよろしく。
で、いきなりトピックスを立てさせてもらうという無茶をしているんですが、ローカルルール等ありましたら、ご指導ください。
さて、Mixiにおいて、Mixiの経営状態云々のニュース等に接したりすると、いつか突然に閉鎖、なんてことがないとも・・・
限らないと思いましてね、mixi日記のセーブツール(勿論、フリーの)があったら欲しいなと、探してみても見当たらない。
で、ちょっと自作してみたんですが、中々、うまく行かない。
まあ、とてもお見せ出来るシロモノでもないのですが、

全然なってないな
とか、
ここを替えるとうまくいくよ
とか、
ああ、それなら、過去にこういうのがあったよ
とか、
別のやり方だけど、こっちの方が簡単だよ
など
お知恵、お力を貸していただけるのではないかと・・・
思いまして、以下に、恥ずかしながら現状を提示させていただく次第です。
目的は、過去の日記を簡単にテキストベースにセーブしたい。
ということです。どうかご協力をお願いします。
-----------------------------------------------------
Option Explicit

Sub WebPageGet1()

Const cnsDTop As String = "<DIV class=listDiaryTitle>"
Const cnsCTop As String = "<DL class=comment>"

Dim OwnerId As String: OwnerId = "399831" 'My Mixi User ID
If OwnerId = "" Then
OwnerId = MsgBox("MIXI ID?")
If OwnerId = "" Then
Exit Sub
End If
End If
Dim DiaryId As String: DiaryId = "" 'Start(最新) Diary ID
If DiaryId = "" Then
DiaryId = MsgBox("日記ID?")
If DiaryId = "" Then
Exit Sub
End If
End If
Dim NextId As String: NextId = ""
Dim stURL As String:
Dim s As String, buf, i As Integer
Dim sE As String, bufE, k As Integer
Dim stGyo As String
Dim ie As Object
Dim j As Long

On Error Resume Next
Set ie = CreateObject("InternetExplorer.Application")

Do While DiaryId <> ""
stURL = "http://mixi.jp/edit_diary.pl?id=" & DiaryId
ie.Visible = True
ie.Navigate (stURL)

' ダウンロード待ち
Do While ie.Busy
Loop
' Sheets("Sheet1").Select
' Range("A1").Select
If MsgBox("この日記をセーブしますか？", vbOKCancel + vbMsgBoxSetForeground) = vbCancel Then
GoTo END_PROC
End If

' 日記本文退避(編集ページ)
sE = ie.document.body.innerHTML
bufE = Split(sE, vbCr)
ie.Visible = False

stURL = "http://mixi.jp/view_diary.pl?owner_id=" & OwnerId & "&id=" & DiaryId
ie.Visible = True
ie.Navigate (stURL)

' ダウンロード待ち
Do While ie.Busy
Loop

' 日記取得(閲覧ページ)
s = ie.document.body.innerHTML
buf = Split(s, vbCr)

Open "C:\Users\Public\Desktop\D" & DiaryId & ".txt" For Output As #1
For i = 0 To UBound(buf)
' 前の日記のid取得
If InStr(buf(i), "前の日記") > 0 Then
stGyo = Mid(buf(i), InStr(buf(i), "前の日記") - 15, 13)
NextId = ""
For j = 1 To 13
If IsNumeric(Mid(stGyo, j, 1)) Then
NextId = NextId & Mid(stGyo, j, 1)
End If
Next j
End If

' 日記本文出力
stGyo = Mid(buf(i), 2, Len(cnsDTop) + 1)
If UCase(stGyo) = UCase(cnsDTop) Then
i = i + 2
stGyo = Mid(buf(i), 6, InStr(buf(i), "<SPAN>") - 6) ' タイトル
stGyo = ImgEdit(stGyo)
Print #1, stGyo
i = i + 1
stGyo = Mid(buf(i), 6, InStr(buf(i), "</DD>") - 6) ' 投稿日時
Print #1, stGyo
i = i + 2

' 本文は編集ページ(退避)より取得
For k = 50 To UBound(bufE)
If InStr(bufE(k), "diaryBody") > 0 Then
stGyo = Mid(bufE(k), InStr(bufE(k), "diaryBody"))
stGyo = Mid(stGyo, InStr(stGyo, ">") + 1)
Print #1, stGyo
k = k + 1
Do While k < UBound(bufE)
stGyo = bufE(k)
If InStr(stGyo, "</TEXTAREA>") > 0 Then
stGyo = Left(stGyo, InStr(stGyo, "</TEXTAREA>") - 1)
k = UBound(bufE) 'FINAL
ElseIf InStr(stGyo, "</div>") > 0 Then
stGyo = Left(stGyo, InStr(stGyo, "</div>") - 1)
k = UBound(bufE) 'FINAL
Else
k = k + 1
End If
stGyo = Replace(stGyo, vbCr, "")
stGyo = Replace(stGyo, vbLf, "")
Print #1, stGyo
Loop
End If
Next k
End If

' コメント出力
stGyo = Mid(buf(i), 2, Len(cnsCTop) + 1)
If UCase(stGyo) = UCase(cnsCTop) Then
Print #1, "=========*=========*=========*=========*=========*=========*"
i = i + 1
stGyo = Mid(buf(i), InStr(buf(i), "id="), InStr(buf(i), "</SPAN>"))
stGyo = ImgEdit(stGyo)
Print #1, stGyo
i = i + 1
stGyo = Mid(buf(i), 5, InStr(buf(i), "</DD>"))
stGyo = ImgEdit(stGyo)
Print #1, stGyo
End If
Next i

Close #1
If NextId = "" Or DiaryId = NextId Then
stURL = "http://mixi.jp/neighbor_diary.pl?id=" & DiaryId & "&owner_id=" & OwnerId & "&direction=prev"
ie.Visible = True
ie.Navigate (stURL)
' ダウンロード待ち
Do While ie.Busy
Loop
edit_diary.pl
s = ie.document.body.innerHTML
buf = Split(s, vbCr)
NextId = ""
For i = 80 To UBound(buf)
' 前の日記のid取得
If InStr(buf(i), "編集する") > 0 Then
stGyo = Mid(buf(i), InStr(buf(i), "編集する") - 15, 13)
For j = 1 To 13
If IsNumeric(Mid(stGyo, j, 1)) Then
NextId = NextId & Mid(stGyo, j, 1)
End If
Next j
End If
Next i
End If
DiaryId = NextId
Loop

Set ie = Nothing

END_PROC:

MsgBox "ウェブページ取得処理終了"

End Sub

' タグ等除去
Private Function ImgEdit(inGyo As String) As String

Dim otGyo As String

inGyo = Replace(inGyo, "</A><SPAN class=date>", "　DATE:")
inGyo = Replace(inGyo, "</SPAN> <SPAN class=operation>", "")
inGyo = Replace(inGyo, " ", "　")
inGyo = Replace(inGyo, "</DD>", "")
inGyo = Replace(inGyo, "</DL>", "")
inGyo = Replace(inGyo, "<br />", "")
inGyo = Replace(inGyo, "<BR>", vbCrLf)
inGyo = Replace(inGyo, ">", "")

If InStr(inGyo, "<IMG") > 0 Then
Dim i As Long: i = 1
Do While i <= Len(inGyo)
If Mid(inGyo, i, 4) = "<IMG" Then
i = i + 5
Do While i <= Len(inGyo) And Mid(inGyo, i, 1) <> ">"
i = i + 1
Loop
Else
otGyo = otGyo & Mid(inGyo, i, 1)
i = i + 1
End If
Loop
Else
otGyo = inGyo
End If

otGyo = Replace(otGyo, """>", "　")
ImgEdit = otGyo

End Function