※上記の広告は60日以上更新のないWIKIに表示されています。更新することで広告が下部へ移動します。

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