Word VBAにてテキスト取得が上手くできない

実現したいこと

例として以下のようなWordファイルをHTMLファイルに出力

結果ソースイメージ

<h1>見出し１</h1>
<h2>見出し２</h2>
<p>サンプル<u>下線</u>サンプル</p>
<p>サンプル<b>マーク</b>サンプル</p>
<h1>見出し１</h1>

発生している問題・分からないこと

該当ソースコードの「under = .range.Text」等の .range.Text が取得できない。

また、何度かコードを修正する中で、文書内では見出し１テキストや見出し２テキストの位置はバラバラだが、出力すると一箇所に固まる（その場でループされている？）

エラーメッセージ

error
1コンパイルエラー：メソッドまたはデータメンバーが見つかりません

該当のソースコード

Sub ExportToHTML()
  ' 出力ファイル名を指定
  Dim outputFileName As String
  outputFileName = "output.html"

  ' 出力ファイルを作成
  Dim outputDoc As Object
  Set outputDoc = CreateObject("htmlfile")

  ' ヘッダーを出力
  outputDoc.Write "<!DOCTYPE html>"
  outputDoc.Write "<html>"
  outputDoc.Write "<head>"
  outputDoc.Write "<meta charset='UTF-8'>"
  outputDoc.Write "<title>Document</title>"
  outputDoc.Write "</head>"
  outputDoc.Write "<body>"

  ' 変換元の Word 文書を開く
  Dim sourceDoc As Document
  Set sourceDoc = ActiveDocument

  ' <h1>タグを付与する
  With sourceDoc.Content.Find
    .ClearFormatting
    .Style = "見出し 1"
    .Execute
    While .Found
      Dim headOne As String
      headOne = .Parent.Text
      outputDoc.Write "<h1>" & headOne & "</h1>"
      .Execute ' 次の見出しを検索
    Wend
  End With

  ' <h2>タグを付与する
  With sourceDoc.Content.Find
    .ClearFormatting
    .Style = "見出し 2"
    .Execute
    While .Found
      Dim headTwo As String
      headTwo = .Parent.Text
      outputDoc.Write "<h2>" & headTwo & "</h2>"
      .Execute ' 次の見出しを検索
    Wend
  End With

  ' <p>タグを付与する
  Dim range As range
  For Each range In sourceDoc.StoryRanges
    With range.Find
    .ClearFormatting
    .Style = "標準"
    .Execute
    While .Found
      outputDoc.Write "<p>"

      ' 下線が引かれているテキストに<u>タグを付与する
      If range.Font.Underline = wdUnderlineSingle Then
        Dim under As String
        under = .range.Text
       outputDoc.Write "<u>" & under & "</u>"

        ' range.InsertBefore "<span class=""under"">"
        ' range.InsertAfter "</span>"
      ' 蛍光ペンがついているテキストに<b>タグを付与する
      ElseIf range.HighlightColorIndex <> wdNoHighlight Then
        Dim mark As String
        mark = .range.Text
        outputDoc.Write "<b>" & mark & "</b>"

        ' range.InsertBefore "<span class=""mark"">"
        ' range.InsertAfter "</span>"
      ' その他のテキストに<p>タグを付与する
      Else
        Dim nomal As String
        nomal = .range.Text
        outputDoc.Write nomal

        ' range.InsertBefore "<p>"
        ' range.InsertAfter "</p>"
      End If
      .Execute

      outputDoc.Write "</p>"
    Wend
    End With
  Next range

  ' フッターを出力
  outputDoc.Write "</body>"
  outputDoc.Write "</html>"

  ' ファイルを保存
  Dim fs As Object
  Set fs = CreateObject("Scripting.FileSystemObject")
  Dim f As Object
  Set f = fs.CreateTextFile(outputFileName, True)
  f.Write outputDoc.body.innerHTML
  f.Close
End Sub

試したこと・調べたこと

teratailやGoogle等で検索した
ソースコードを自分なりに変更した
知人に聞いた
その他

上記の詳細・結果

補足

特になし

行動規範の内容に同意します

回答1件

ベストアンサー

公式リファレンスを見てみましたが、
https://learn.microsoft.com/ja-jp/office/vba/api/word.find
With range.Findのrange.Findで返されるFindオブジェクトには、.rangeというメソッドもプロパティーもないので、そういうエラーメッセージになるのでしょう。
参考にしたページからコピペする時に何らかの間違いがあったとかですかね。
コピペじゃなくて手打ちなら、With ～ End Withの中で.から打てばその後に続けられるメソッドやプロパティーの候補がリストで出てくると思いますが、それを無視して、rangeと打っちゃったと言うことでしょうが、リストに出てこないものはそこでは使えませんよ。