読者です 読者をやめる 読者になる 読者になる

B-Teck!

お仕事からゲームまで幅広く

【VBA/Access】ファイル内のクエリをテキストファイルに一括出力する

VBA

ファイル内のクエリを一括で吐き出して検索かけたいことがあったので1ファイルに吐き出すようにするプロシージャを作成。

'/**
' * outputQuery
' * クエリをテキストファイルに出力
' * @param Optional i_outputPath    (出力先を指定する場合)ディレクトリパス
' * @param Optional i_outputName    (出力ファイル名を指定する場合)ファイル名
' * @return True:処理成功 False:処理失敗
' */
Public Function outputQuery(Optional ByVal i_outputPath As String = "", _
                       Optional ByVal i_outputName As String = "") As Boolean

    Dim accObj          As AccessObject  'クエリ保持用変数
    Dim dbObj           As Object        'DAOのDBエンジン
    Dim myDb            As Object        'DAO.DataBase
    Dim currentQuery    As Object        'DAO.QueryDefs
    Dim fso             As Object
    
    Dim outputPath      As String        '出力先パス
    Dim outputName      As String        '出力ファイル名
    Dim funcResult      As Boolean
    Dim lngOutFile      As Long
    
    lngOutFile = FreeFile
    Set fso = CreateObject("Scripting.FileSystemObject")

On Error GoTo Proc_Exit

    '-------------------------------------------------------
    '出力ファイル名設定
    '引数が設定されていなかった場合は現在の時刻をファイルに
    '-------------------------------------------------------
    If i_outputName = "" Then
        outputName = "\" & Format(Now(), "yyyymmdd_hhmmss") & "_Query.txt"
    Else
        outputName = "\" & i_outputName
        
        '引数のファイル名に拡張子がなければ設定
        If InStr(i_outputName, ".txt") = 0 Then
            outputName = outputName & ".txt"
        End If
    End If
    
    '-------------------------------------------------------
    '出力先の設定
    '引数が設定されていなかった場合は自ファイルのあるディレクトリに
    '-------------------------------------------------------
    If i_outputPath = "" Then
        outputPath = CurrentProject.Path & outputName
    Else
        '設定されたディレクトリの存在確認
        If Not fso.folderExists(i_outputPath) Then
            MsgBox "設定された出力先が存在しません", vbInformation
            GoTo Proc_Exit
        End If
        
        outputPath = i_outputPath & outputName
    End If
    
    '-------------------------------------------------------
    'DAOの参照がない場合もあるためDAOエンジンのオブジェクトを作成
    '-------------------------------------------------------
    Set dbObj = CreateObject("DAO.DBEngine.120")
    Set myDb = dbObj.Workspaces(0).OpenDatabase(CurrentProject.FullName)
    
    '-------------------------------------------------------
    'ファイル出力
    '-------------------------------------------------------
    Open outputPath For Output As #lngOutFile
    
    For Each accObj In CurrentData.AllQueries
        '取得したクエリ名からQueryDefsオブジェクトを取得し、名称・内容を出力
        Set currentQuery = myDb.QueryDefs(accObj.Name)
        Print #lngOutFile, "・ " & currentQuery.Name
        Print #lngOutFile, currentQuery.SQL
    Next
    
    funcResult = True

Proc_Exit:
    '-------------------------------------------------------
    '終了処理
    '-------------------------------------------------------
    Close #lngOutFile
    Set currentQuery = Nothing
    Set myDb = Nothing
    
    outputQuery = funcResult
End Function