Accessからファイルエクスポート - toolstorage

Accessからファイルエクスポート

• ソース

Option Compare Database
Option Explicit

' ACC_ExportFile
' AccessのDBからテーブルのレコードをファイル形式を指定してエクスポートする
' DBを指定した場合、指定のDBからエクスポートを行う
' DBを指定しない場合、カレントプロジェクトからエクスポートを行う

Private DbPath As String

Private Sub class_initialize()
    DbPath = ""
End Sub

' SetDbPath
' CurrentProject以外のDBに接続する場合ファイルパスを設定する
' ファイルパスの有効性確認は事前に行うこと
' 引数：あり
' iFilePath ：String    ：ファイル（含ファイルまでのフルパス）
' 戻り値：なし
Public Function SetDbPath(ByVal iFilePath As String)
    DbPath = iFilePath
End Function

' ExportTableXLS
' 指定テーブルをExcel2000-2003形式（拡張子「xls」）でエクスポートする
' DbPathが空ではなかった場合、指定DBからエクスポートを行う
' 引数：あり
' iExportObjectName ：String    ：エクスポートする対象名
' iExportFilePath ：String    ：エクスポート時のファイル名（含ファイルまでのフルパス）
' 戻り値：なし
Public Function ExportTableXLS(ByVal iExportObjectName As String, ByVal iExportFilePath As String)
    ' 1.エクスポートを実行する
    ' 設定値　＝8（AcSpreadSheetType.acSpreadsheetTypeExcel9）
    Call BaseExportTableToExcel(8, iExportObjectName, iExportFilePath)
End Function

' ExportTableXLSX
' 指定テーブルをExcel2007-2010形式（拡張子「xlsx」）でエクスポートする
' DbPathが空ではなかった場合、指定DBからエクスポートを行う
' ※2003以前で動作させる場合はマスクして封鎖する
' 引数：あり
' iExportObjectName ：String    ：エクスポートする対象名
' iExportFilePath ：String    ：エクスポート時のファイル名（含ファイルまでのフルパス）
' 戻り値：なし
Public Function ExportTableXLSX(ByVal iExportObjectName As String, ByVal iExportFilePath As String)
    ' 1.エクスポートを実行する
    ' 設定値　＝10（AcSpreadSheetType.acSpreadsheetTypeExcel12Xml）
    Call BaseExportTableToExcel(10, iExportObjectName, iExportFilePath)
End Function


' BaseExportTableToExcel
' Excel形式でテーブルまたはクエリをエクスポートする
' 属性のDbPathが空ではなかった場合、指定DBからエクスポートを行う
' 引数：あり
' ExportFileType ：AcSpreadSheetType    ：エクスポート時のエクセルのファイルバージョン
' iExportObjectName ：String    ：エクスポートする対象名
' iExportFilePath ：String    ：エクスポート時のファイル名（含ファイルまでのフルパス）
' 戻り値：なし
Public Function BaseExportTableToExcel(ByVal ExportFileType As AcSpreadSheetType, _
                                       ByVal iExportObjectName As String, _
                                       ByVal iExportFilePath As String)
    
    Dim appObj As Access.Application
    
    ' 1.DB指定の有無確認
    If DbPath <> "" Then
        ' A.指定DBからのエクスポート
        Set appObj = New Access.Application
        appObj.Visible = True
        appObj.OpenCurrentDatabase DbPath
        
        appObj.DoCmd.TransferSpreadsheet acExport, ExportFileType, iExportObjectName, iExportFilePath
        
        Set appObj = Nothing
    Else
        ' A.カレントプロジェクトからのエクスポート
        DoCmd.TransferSpreadsheet acExport, ExportFileType, iExportObjectName, iExportFilePath
    End If
End Function


' ExportTableToText
' Excel形式でテーブルまたはクエリをエクスポートする
' 属性のDbPathが空ではなかった場合、指定DBからエクスポートを行う
' 引数：あり
' iExportDefinition ：String    ；エクスポート定義名
' iExportObjectName ：String    ：エクスポートする対象名
' iExportFilePath ：String    ：エクスポート時のファイル名（含ファイルまでのフルパス）
' 戻り値：なし
Public Function ExportTableToText(ByVal iExportDefinition As String, _
                                  ByVal iExportObjectName As String, _
                                  ByVal iExportFilePath As String)
    
    Dim appObj As Access.Application
    
    ' 1.DB指定の有無確認
    If DbPath <> "" Then
        ' A.指定DBからのエクスポート
        Set appObj = New Access.Application
        appObj.Visible = True
        appObj.OpenCurrentDatabase DbPath
        
        appObj.DoCmd.TransferText acExportDelim, iExportDefinition, iExportObjectName, iExportFilePath
        
        appObj.Quit
        Set appObj = Nothing
    Else
        ' A.カレントプロジェクトからのエクスポート
        DoCmd.TransferText acExportDelim, iExportDefinition, iExportObjectName, iExportFilePath
    End If

End Function

トップ