「Accessにファイルインポート」の編集履歴（バックアップ）一覧はこちら

「Accessにファイルインポート」(2013/06/10 (月) 01:02:31) の最新版変更点

追加された行は緑色になります。

削除された行は赤色になります。

***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
 

[[トップ]]