PDFのしおり情報抽出・出力【再】

投稿者 : ぐら     投稿日時 : 2023/09/04(Mon) 09:01:31     OS : 未指定     EXCEL : 未指定

---

以前同様の質問タイトルで質問したものです。
https://www.ka-net.org/blog/?p=13440
上記URLを参考にしつつ、自身でコードを下記のようにしました

Private Sub DumpBookmark(ByVal bkm As Object, ByVal avpv As Object, ByVal parentName As String, ByVal hierarchy As Integer)
   
    Dim cld As Variant, cld2 As Variant
  
    On Error Resume Next

    cld = CallByName(bkm, "children", VbGet)
    
    On Error GoTo 0
    
    If IsEmpty(cld) = False Then
        For Each cld2 In cld
            CallByName cld2, "execute", VbMethod
            Dim currentName As String
            currentName = CallByName(cld2, "name", VbGet)
            
      
            With Worksheets("Sheet1")
                Dim lastRow As Long
                lastRow = .Cells(.Rows.Count, "H").End(xlUp).Row + 1
                
                If hierarchy = 1 Then
                    .Cells(lastRow, "H").Value = currentName
                ElseIf hierarchy = 2 Then
                    .Cells(lastRow, "H").Value = parentName
                    .Cells(lastRow, "I").Value = currentName
                ElseIf hierarchy = 3 Then
                    .Cells(lastRow, "H").Value = parentName
                    .Cells(lastRow, "I").Value = parentName
                    .Cells(lastRow, "J").Value = currentName
                ElseIf hierarchy = 4 Then
                    .Cells(lastRow, "H").Value = parentName
                    .Cells(lastRow, "I").Value = parentName
                    .Cells(lastRow, "J").Value = parentName
                    .Cells(lastRow, "K").Value = currentName
                ElseIf hierarchy = 5 Then
                    .Cells(lastRow, "H").Value = parentName
                    .Cells(lastRow, "I").Value = parentName
                    .Cells(lastRow, "J").Value = parentName
                    .Cells(lastRow, "K").Value = parentName
                    .Cells(lastRow, "L").Value = currentName
                End If
                
                .Cells(lastRow, "M").Value = avpv.GetPageNum + 1
            End With
            
          DumpBookmark cld2, avpv, currentName, hierarchy + 1
            
        Next
End If
End Sub

問題点は一目瞭然だと思いますが、しおりの階層構造を二種類にしか定義していないことで、階層が3以上の時に複数セルに同じ内容が出力されてしまいます。
本来は自分で考えるべきなのですが、まずどのように階層ごとに定義すればいいのかが全く分からずに進行できない状態で、そもそも上記の認識であっているかもわかりません。
他力本願にはなりますがどうかコードの修正方法を教えていただけますでしょうか。よろしくお願いいたします。

投稿者 : さんこう     投稿日時 : 2023/09/04(Mon) 09:50:18

---

前回回答しましたが、お行儀悪く「データを書き出すときに、上の階層のデータを１行上からコピー」ではダメですか？

Private Sub DumpBookmark(ByVal bkm As Object, ByVal avpv As Object, ByVal parentName As String, ByVal hierarchy As Integer)
   
    Dim cld As Variant, cld2 As Variant
  
    On Error Resume Next
    cld = CallByName(bkm, "children", VbGet)
    On Error GoTo 0
    
    If IsEmpty(cld) = False Then
        For Each cld2 In cld
            CallByName cld2, "execute", VbMethod
            Dim currentName As String
            currentName = CallByName(cld2, "name", VbGet)
      
            With Worksheets("Sheet1")
                Dim lastRow As Long
                lastRow = .Cells(.Rows.Count, "H").End(xlUp).Row + 1
                
                .Cells(lastRow, hierarchy + 6).Value = currentName
                For c = 1 To hierarchy - 1
                    .Cells(lastRow, c + 6).Value = .Cells(lastRow - 1, c + 6).Value
                Next
                
                .Cells(lastRow, "M").Value = avpv.GetPageNum + 1
            End With
            
            DumpBookmark cld2, avpv, currentName, hierarchy + 1
            
        Next
    End If
End Sub

もしくは、親階層のデータを配列で渡すとかでしょうか。

繰り返しになりますが、Acrobatを持っていなく試せませんので、あっているかわかりません。

投稿者 : ごんぼほり     投稿日時 : 2023/09/04(Mon) 10:06:54

---

こんな感じで、最初に　DumpBookmark を呼ぶときに書き出しの始点を指定します

Private Sub DumpBookmark(ByVal bkm As Object, ByVal avpv As Object, Optional ByRef rPos As Long = 1, Optional ByRef cPos As Long = 1)
'しおりの情報を出力
  Dim cld As Variant, cld2 As Variant
   
  On Error Resume Next
  cld = CallByName(bkm, "children", VbGet)
  On Error GoTo 0
  If IsEmpty(cld) = False Then
    For Each cld2 In cld
      CallByName cld2, "execute", VbMethod 'しおり選択
      Cells(rPos, cPos).Value = "名前：" & CallByName(cld2, "name", VbGet) & "     ページ：" & avpv.GetPageNum + 1
      rPos = rPos + 1
      DumpBookmark cld2, avpv, rPos, cPos + 1
    Next
  End If
End Sub

投稿者 : ぐら     投稿日時 : 2023/09/04(Mon) 10:40:22

---

■[返信 1] さんこうさん（2023-09-04 09:50:18）の記事
＞ 前回回答しましたが、お行儀悪く「データを書き出すときに、上の階層のデータを１行上からコピー」ではダメですか？
＞
＞
＞ Private Sub DumpBookmark(ByVal bkm As Object, ByVal avpv As Object, ByVal parentName As String, ByVal hierarchy As Integer)
＞
＞ Dim cld As Variant, cld2 As Variant
＞
＞ On Error Resume Next
＞ cld = CallByName(bkm, "children", VbGet)
＞ On Error GoTo 0
＞
＞ If IsEmpty(cld) = False Then
＞ For Each cld2 In cld
＞ CallByName cld2, "execute", VbMethod
＞ Dim currentName As String
＞ currentName = CallByName(cld2, "name", VbGet)
＞
＞ With Worksheets("Sheet1")
＞ Dim lastRow As Long
＞ lastRow = .Cells(.Rows.Count, "H").End(xlUp).Row + 1
＞
＞ .Cells(lastRow, hierarchy + 6).Value = currentName
＞ For c = 1 To hierarchy - 1
＞ .Cells(lastRow, c + 6).Value = .Cells(lastRow - 1, c + 6).Value
＞ Next
＞
＞ .Cells(lastRow, "M").Value = avpv.GetPageNum + 1
＞ End With
＞
＞ DumpBookmark cld2, avpv, currentName, hierarchy + 1
＞
＞ Next
＞ End If
＞ End Sub
＞
＞
＞ もしくは、親階層のデータを配列で渡すとかでしょうか。
＞
＞ 繰り返しになりますが、Acrobatを持っていなく試せませんので、あっているかわかりません。

大変お恥ずかしい限りですが、助言いただいた内容を試すだけにの知識がなく、もう一度質問してしまいました。
コメントしていただいたコードを下記のように変更したら私の望むとおりの出力になりました。前回に引き続きご助力いただきましてありがとうございました。

Private Sub DumpBookmark(ByVal bkm As Object, ByVal avpv As Object, ByVal parentName As String, ByVal hierarchy As Integer)
   
    Dim cld As Variant, cld2 As Variant
  
    On Error Resume Next
    cld = CallByName(bkm, "children", VbGet)
    On Error GoTo 0
    
    If IsEmpty(cld) = False Then
        For Each cld2 In cld
            CallByName cld2, "execute", VbMethod
            Dim currentName As String
            currentName = CallByName(cld2, "name", VbGet)
      
            With Worksheets("Sheet1")'
                Dim lastRow As Long
                lastRow = .Cells(.Rows.Count, "H").End(xlUp).Row + 1
                
                Dim c As Long
                .Cells(lastRow, hierarchy + 7).Value = currentName
                For c = 1 To hierarchy - 1
                    .Cells(lastRow, c + 7).Value = .Cells(lastRow - 1, c + 7).Value
                Next
                
                .Cells(lastRow, "M").Value = avpv.GetPageNum + 1
            End With
            
            DumpBookmark cld2, avpv, currentName, hierarchy + 1
            
        Next
    End If
End Sub

投稿者 : ぐら     投稿日時 : 2023/09/04(Mon) 10:43:52

---

■[返信 2] ごんぼほりさん（2023-09-04 10:06:54）の記事
＞ こんな感じで、最初に　DumpBookmark を呼ぶときに書き出しの始点を指定します
＞
＞ Private Sub DumpBookmark(ByVal bkm As Object, ByVal avpv As Object, Optional ByRef rPos As Long = 1, Optional ByRef cPos As Long = 1)
＞ 'しおりの情報を出力
＞ Dim cld As Variant, cld2 As Variant
＞
＞ On Error Resume Next
＞ cld = CallByName(bkm, "children", VbGet)
＞ On Error GoTo 0
＞ If IsEmpty(cld) = False Then
＞ For Each cld2 In cld
＞ CallByName cld2, "execute", VbMethod 'しおり選択
＞ Cells(rPos, cPos).Value = "名前：" & CallByName(cld2, "name", VbGet) & " ページ：" & avpv.GetPageNum + 1
＞ rPos = rPos + 1
＞ DumpBookmark cld2, avpv, rPos, cPos + 1
＞ Next
＞ End If
＞ End Sub
＞

返信いただきありがとうございます。
前のコメントにある通り出力に関しては解決いたしましたが、上記のコードの短さとBeRefを使用したコードを見たことがなかったので参考にさせていただき勉強してみます。
ありがとうございます。