モジュール一括出力

調子に乗ってもう1個。
もうちょっと深堀できるようにしたいところ。

Private Declare Sub keybd_event _
Lib "user32" ( _
ByVal bVk As Byte _
, ByVal bScan As Byte _
, ByVal dwFlags As Long _
, ByVal dwExtraInfo As Long)

Public Function DumpVBModule(sDBFileName As String) As Boolean
  Dim app As Access.Application
  Dim myVBE As vbe
  Dim myVBproject As VBProject
  Dim myVBComp As VBComponent
  Dim ext As String
  Dim sPath As String
  Dim fs As FileSystemObject
  Dim ts As TextStream
  Dim sProcName() As String
  Dim i As Long
  Dim j As Long
  Dim buf As String
  Dim buf2 As String
  Dim vProcName() As Variant
  
  If Dir(sDBFileName) = "" Then
    DumpVBModule = False
    Exit Function
  End If
  sPath = Left(sDBFileName, InStrRev(sDBFileName, ".") - 1)
  If Dir(sPath, vbDirectory) = "" Then MkDir sPath
  If Dir(sPath & "\VBModules", vbDirectory) = "" Then MkDir sPath & "\VBModules"
  sPath = sPath & "\VBModules"
  Set fs = New FileSystemObject
  Set ts = fs.CreateTextFile(sPath & "\index.txt", True)
  
  Call keybd_event(CByte(vbKeyShift), 0, 0, 0)
  Set app = New Access.Application
  
  app.OpenCurrentDatabase (sDBFileName)
  
  Set myVBproject = app.vbe.VBProjects(1)
  For Each myVBComp In myVBproject.VBComponents
    Select Case myVBComp.Type
    
      Case 1
        ext = ".bas"
      Case 2, 100
        ext = ".cls"
      Case 3
        ext = ".frm"
    End Select
    myVBComp.Export sPath & "\" & myVBComp.Name & ext
    With myVBComp.CodeModule
      
      'プロシージャ名を取得
      j = 0
      ts.Write "モジュール名:" & myVBComp.Name
      buf = ""
      buf2 = ""
      For i = 1 To .CountOfLines
        If buf <> .ProcOfLine(i, vbext_pk_Proc) Then
          buf = .ProcOfLine(i, vbext_pk_Proc)
          If buf2 <> "" Then buf2 = buf2 & ","
          buf2 = buf2 & buf
          
          
          j = j + 1
        End If
      Next i
      ts.WriteLine "(" & j & ")->" & buf2

    End With
  Next myVBComp
  ts.Close
  app.CloseCurrentDatabase
  app.Quit
  Call keybd_event(CByte(vbKeyShift), 0, 2, 0)
  DumpVBModule = True
  
End Function