Accessにファイルインポート - toolstorage

Accessにファイルインポート

• ソース

Option Compare Database
Option Explicit

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

Private DbPath As String

Private Sub class_initialize()
    '1.属性初期化
    DbPath = ""
End Sub

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

' ImportTextFile
' テキストファイルをインポートする
' 引数：あり
' iDefinedName     ：　String   ；インポート定義名
' iImportTableName    ：　String  ：インポート対象のテーブル名
' iImportFilePath    ：　String  ：インポート対象のファイル名（含フォルダパス）
' iHasFieldNameHeader    ：　Boolean  ：ヘッダ行の有無
' 戻り値：なし
Public Function ImportTextFile(ByVal iDefinedName As String, _
                               ByVal iImportTableName As String, _
                               ByVal iImportFilePath As String, _
                               Optional iHasFieldNameHeader As Boolean = True)
    Dim appObj As Access.Application
    
    ' 1.DB指定の有無確認
    If DbPath <> "" Then
        ' A.指定DBへインポート
        Set appObj = New Access.Application
        ' (1).アプリケーションの可視化
        appObj.Visible = True
        ' (2).参照先DBの設定
        appObj.OpenCurrentDatabase DbPath
        
        ' (3).インポート実行
        appObj.DoCmd.TransferText acImportDelim, iDefinedName, iImportTableName, iImportFilePath, iHasFieldNameHeader
        
        ' (4).アプリケーションの解放
        Set appObj = Nothing
    Else
        ' B.カレントプロジェクトへインポート
        ' (1).インポート実行
        DoCmd.TransferText acImportDelim, iDefinedName, iImportTableName, iImportFilePath, iHasFieldNameHeader
    End If
End Function


' ImportXLSFile
' エクセルファイルをインポートする
' シート名や名前の指定はなし
' 引数：あり
' iImportTableName    ：　String  ：インポート対象のテーブル名
' iImportFilePath    ：　String  ：インポート対象のファイル名（含フォルダパス）
' iHasFieldNameHeader    ：　Variant  ：ヘッダ行の有無（Boolean）
' 戻り値：なし
Public Function ImportXLSFile(ByVal iImportTableName As String, _
                              ByVal iImportFilePath As String, _
                              Optional iHasFieldNameHeader As Variant = Empty)
    ' 1.インポートを実行
    ' SpreadsheetTypeの設定値＝8（AcSpreadSheetType.acSpreadsheetTypeExcel9）
    Call BaseImportExcelFile(8, iImportTableName, iImportFilePath, iHasFieldNameHeader)
    
End Function

' ImportXLSFileSheet
' エクセルファイルをインポートする
' シート名を指定してエクセルファイルをインポートする
' 引数：あり
' iImportTableName    ：　String  ：インポート対象のテーブル名
' iImportFilePath    ：　String  ：インポート対象のファイル名（含フォルダパス）
' iImportSheetName    ：　String  ：インポート対象のシート名
' iHasFieldNameHeader    ：　Variant  ：ヘッダ行の有無（Boolean）
' 戻り値：なし
Public Function ImportXLSFileSheet(ByVal iImportTableName As String, _
                                   ByVal iImportFilePath As String, _
                                   ByVal iImportSheetName As String, _
                                   Optional iHasFieldNameHeader As Variant = Empty)
    ' 1.インポートを実行
    ' SpreadsheetTypeの設定値＝8（AcSpreadSheetType.acSpreadsheetTypeExcel9）
    Call BaseImportExcelFile(8, iImportTableName, iImportFilePath, iHasFieldNameHeader, iImportSheetName & "!")
End Function

' ImportXLSRange
' エクセルファイルをインポートする
' 名前範囲を指定してエクセルファイルをインポートする
' 引数：あり
' iImportTableName    ：　String  ：インポート対象のテーブル名
' iImportFilePath    ：　String  ：インポート対象のファイル名（含フォルダパス）
' iImportAreaName    ：　String  ：インポート対象の名前範囲
' iHasFieldNameHeader    ：　Variant  ：ヘッダ行の有無（Boolean）
' 戻り値：なし
Public Function ImportXLSRange(ByVal iImportTableName As String, _
                               ByVal iImportFilePath As String, _
                               ByVal iImportAreaName As String, _
                               Optional iHasFieldNameHeader As Variant = Empty)
    ' 1.インポートを実行
    ' SpreadsheetTypeの設定値＝8（AcSpreadSheetType.acSpreadsheetTypeExcel9）
    Call BaseImportExcelFile(8, iImportTableName, iImportFilePath, iHasFieldNameHeader, iImportAreaName)
End Function

' ImportXLSXFile
' エクセルファイル（拡張子XLSX）をインポートする
' シート名や名前の指定はなし
' Accessのバージョンが2007以降の場合のみ動作
' 引数：あり
' iImportTableName    ：　String  ：インポート対象のテーブル名
' iImportFilePath    ：　String  ：インポート対象のファイル名（含フォルダパス）
' iHasFieldNameHeader    ：　Variant  ：ヘッダ行の有無（Boolean）
' 戻り値：なし
Public Function ImportXLSXFile(ByVal iImportTableName As String, _
                               ByVal iImportFilePath As String, _
                               Optional iHasFieldNameHeader As Variant = Empty)
    Dim versionNumber As Double
    
    ' 1.エクセルのバージョン取得
    versionNumber = Access.Application.Version
    
    ' 2.バージョン判定を行いインポートを実行
    ' SpreadsheetTypeの設定値＝10（AcSpreadSheetType.acSpreadsheetTypeExcel12Xml）
    If versionNumber > 11 Then
        Call BaseImportExcelFile(10, iImportTableName, iImportFilePath, iHasFieldNameHeader)
    End If
End Function

' ImportXLSXFileSheet
' エクセルファイル（拡張子XLSX）をインポートする
' シート名を指定してエクセルファイルをインポートする
' Accessのバージョンが2007以降の場合のみ動作
' 引数：あり
' iImportTableName    ：　String  ：インポート対象のテーブル名
' iImportFilePath    ：　String  ：インポート対象のファイル名（含フォルダパス）
' iImportSheetName    ：　String  ：インポート対象のシート名
' iHasFieldNameHeader    ：　Variant  ：ヘッダ行の有無（Boolean）
' 戻り値：なし
Public Function ImportXLSXFileSheet(ByVal iImportTableName As String, _
                                    ByVal iImportFilePath As String, _
                                    ByVal iImportSheetName As String, _
                                    Optional iHasFieldNameHeader As Variant = Empty)
    ' 1.インポートを実行
    ' SpreadsheetTypeの設定値＝10（AcSpreadSheetType.acSpreadsheetTypeExcel12Xml）
    If versionNumber > 11 Then
        Call BaseImportExcelFile(10, iImportTableName, iImportFilePath, iHasFieldNameHeader, iImportSheetName & "!")
    End If
End Function

' ImportXLSXRange
' エクセルファイル（拡張子XLSX）をインポートする
' 名前範囲を指定してエクセルファイルをインポートする
' Accessのバージョンが2007以降の場合のみ動作
' 引数：あり
' iImportTableName    ：　String  ：インポート対象のテーブル名
' iImportFilePath    ：　String  ：インポート対象のファイル名（含フォルダパス）
' iImportAreaName    ：　String  ：インポート対象の名前範囲
' iHasFieldNameHeader    ：　Variant  ：ヘッダ行の有無（Boolean）
' 戻り値：なし
Public Function ImportXLSXRange(ByVal iImportTableName As String, _
                                ByVal iImportFilePath As String, _
                                ByVal iImportAreaName As String, _
                                Optional iHasFieldNameHeader As Variant = Empty)
    ' 1.インポートを実行
    ' SpreadsheetTypeの設定値＝10（AcSpreadSheetType.acSpreadsheetTypeExcel12Xml）
    If versionNumber > 11 Then
        Call BaseImportExcelFile(10, iImportTableName, iImportFilePath, iHasFieldNameHeader, iImportAreaName)
    End If
End Function

' BaseImportExcelFile
' エクセルファイルをインポートする基本機能を持つ
' 引数：あり
' iImportFileType   ：　AcSpreadSheetType    ：インポートするファイルの形式
' iImportTableName    ：　String  ：インポート対象のテーブル名
' iImportFilePath    ：　String  ：インポート対象のファイル名（含フォルダパス）
' iHasFieldNameHeader    ：　Variant  ：ヘッダ行の有無（Boolean）
' iRangeName    ：　Variant  ：インポート対象ファイルのインポート範囲
' 戻り値：なし
Public Function BaseImportExcelFile(ByVal iImportFileType As AcSpreadSheetType, _
                                    ByVal iImportTableName As String, _
                                    ByVal iImportFilePath As String, _
                                    Optional ByVal iHasFieldNameHeader As Variant = True, _
                                    Optional ByVal iRangeName As Variant = Empty)
    
    Dim appObj As Access.Application
    
    ' 1.DB指定の有無確認
    If DbPath <> "" Then
        ' A.指定DBへインポート
        Set appObj = New Access.Application
        ' (1).アプリケーションの可視化
        appObj.Visible = True
        ' (2).参照先DBの設定
        appObj.OpenCurrentDatabase DbPath
        
        ' (3).インポート実行
        appObj.DoCmd.TransferSpreadsheet acImport, _
                                         iImportFileType, _
                                         iImportTableName, _
                                         iImportFilePath, _
                                         iHasFieldNameHeader, _
                                         iRangeName
        
        ' (4).アプリケーションの解放
        Set appObj = Nothing
    Else
        ' B.カレントプロジェクトへインポート
        ' (1).インポート実行
        DoCmd.TransferSpreadsheet acImport, _
                                  iImportFileType, _
                                  iImportTableName, _
                                  iImportFilePath, _
                                  iHasFieldNameHeader, _
                                  iRangeName
    End If
    
End Function

トップ