2012年4月19日木曜日

[ACCESS]ACCESSファイル内のフォーム、レポートのデータソースをテキストファイルで吐き出す。

From Evernote:

[ACCESS]ACCESSファイル内のフォーム、レポートのデータソースをテキストファイルで吐き出す。

ACCESSファイル内のフォーム、レポートに埋め込まれているデータソースを調べるのはメンドクサイので、
データソース内容一覧をテキストファイルで吐き出します。
(97以降対応)
フォームの場合は、それぞれのコントロールを見て、
データソースを持っていれば書き出しています。


'--------------------------------------------------------------------------------

Private Sub Click ()

    Dim motoName As String
    motoName = "データソース" & Format(Today, "ddhhss")
  
    Dim strMdbName As String
  
    SaveModules strMdbName, "", "C:\******.txt"

End Sub

Sub SaveModules (strMdbName As String, strPw As String, strExpFile As String)
  
    Dim dbs As Database
    Set dbs = DBEngine(0)(0)
    Dim docWork As Document
    Dim frm As Form
    Dim rpt As Report

    On Error Resume Next

' リストを出力するファイル名
    'Const FILENAME = strExpFile
  
    Open strExpFile For Output As #100
    Print #100, "■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■"
    Print #100, "■     MDB Name : " & strMdbName
    Print #100, "■    CreateDay : " & Now
    Print #100, "■"
    Print #100, "■    Copyright (c) 1997-20xx 7key All Rights Reserved."
    Print #100, "■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■"
    Print #100, ""
    Print #100, ""
          
    Print #100, ""
    Print #100, "■■■  FORMS   ■■■■■■■■■■■■■■■■■■■■■■■■■■■■"
    Print #100, ""
    Print #100, ""
  
    'Set dbs = DBEngine.Workspaces(0).OpenDatabase(strMdbName, False, False, ";PWD=" & strPw)
  
  
    Dim IDX As Long
    For IDX = 0 To dbs.containers!Forms.Documents.Count - 1
        Set docWork = dbs.containers!Forms.Documents(IDX)

        DoCmd フォームを開く docWork.Name, A_DESIGN
      
        Set frm = Forms(docWork.Name)
        'If frm.HasModule Then
        'Set mdl = frm.Module
        Print #100, "□□□□□□□□□□□□□□□□□□□□□□□□□□□□□□□"
        Print #100, "□ Module Name : " & docWork.Name
        Print #100, "□     Created : " & docWork.DateCreated
        Print #100, "□    Modified : " & docWork.LastUpdated
        Print #100, "□□□□□□□□□□□□□□□□□□□□□□□□□□□□□□□"
        Print #100, ""
        'Print #100, mdl.Lines(1, mdl.CountOfLines)
      
        Dim IDX2 As Long
        For IDX2 = 1 To frm.Count
            If Len(RTrim(CStr(frm(IDX2 - 1).RowSource))) > 0 Then
                Print #100, "--------------------"
                Print #100, frm(IDX2 - 1).Name
                Print #100, frm(IDX2 - 1).RowSource
                Print #100, "--------------------"
            End If
        Next
          
          
        'End If
        DoCmd 閉じる a_Form, docWork.Name
    Next

    Print #100, ""
    Print #100, ""
    Print #100, "■■■  REPORTS   ■■■■■■■■■■■■■■■■■■■■■■■■■■■"
    Print #100, ""
    Print #100, ""
  
    Dim IDX3 As Long
    For IDX3 = 0 To dbs.containers!Forms.Documents.Count - 1
        On Error Resume Next
        DoCmd レポートを開く docWork.Name, A_DESIGN
        Set rpt = Reports(docWork.Name)
            'Set mdl = rpt.Module
            Print #100, "□□□□□□□□□□□□□□□□□□□□□□□□□□□□□□□"
            Print #100, "□ Module Name : " & docWork.Name
            Print #100, "□     Created : " & docWork.DateCreated
            Print #100, "□    Modified : " & docWork.LastUpdated
            Print #100, "□□□□□□□□□□□□□□□□□□□□□□□□□□□□□□□"
            Print #100, ""
            Print #100, rpt.RecordSource
        DoCmd 閉じる a_Report, docWork.Name
    Next
  
  
    Close #100
    dbs.Close
    Set dbs = Nothing

End Sub

0 件のコメント:

コメントを投稿