Function INP_TBL(TBL_Name, Excel_Adress, Excel_SheetName, Para)
'TBL_Name ･･･ インポートするテーブル名
'Excel_Adress ･･･ Excelファイルのフルパス
'Excel_SheetName ･･･ Excelシート名
'Para ･･･ 処理の選択
On Error GoTo ERR_INP_TBL
Dim strMsg As String
If Dir(Excel_Adress) = "" Then
MsgBox "エクセルファイルが存在しません"
Else
Select Case Para
Case 1 '既存テーブルを削除してテーブルを作成します。
'1行目をフィールド名として使用しません
DoCmd.DeleteObject acTable, TBL_Name
If InStr(Excel_SheetName, "!") > 0 Then
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel8, TBL_Name, Excel_Adress, False, Excel_SheetName
Else
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel8, TBL_Name, Excel_Adress, False, Excel_SheetName & "!"
End If
Case 2 '既存テーブルを削除してテーブルを作成します。
'1行目をフィールド名として使用します
DoCmd.DeleteObject acTable, TBL_Name
If InStr(Excel_SheetName, "!") > 0 Then
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel8, TBL_Name, Excel_Adress, True, Excel_SheetName
Else
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel8, TBL_Name, Excel_Adress, True, Excel_SheetName & "!"
End If
Case 3 '既存テーブルにレコードを追加します
'1行目をフィールド名として使用しません
If InStr(Excel_SheetName, "!") > 0 Then
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel8, TBL_Name, Excel_Adress, False, Excel_SheetName
Else
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel8, TBL_Name, Excel_Adress, False, Excel_SheetName & "!"
End If
Case 4 '既存テーブルにレコードを追加します
'1行目をフィールド名として使用します
If InStr(Excel_SheetName, "!") > 0 Then
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel8, TBL_Name, Excel_Adress, True, Excel_SheetName
Else
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel8, TBL_Name, Excel_Adress, True, Excel_SheetName & "!"
End If
Case 5 '既存テーブルのレコードを削除して追加します
'1行目をフィールド名として使用しません
DoCmd.RunSQL "DELETE " & TBL_Name & ".* FROM " & TBL_Name & ";"
If InStr(Excel_SheetName, "!") > 0 Then
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel8, TBL_Name, Excel_Adress, False, Excel_SheetName
Else
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel8, TBL_Name, Excel_Adress, False, Excel_SheetName & "!"
End If
Case 6 '既存テーブルのレコードを削除して追加します
'1行目をフィールド名として使用します
DoCmd.RunSQL "DELETE " & TBL_Name & ".* FROM " & TBL_Name & ";"
If InStr(Excel_SheetName, "!") > 0 Then
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel8, TBL_Name, Excel_Adress, True, Excel_SheetName
Else
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel8, TBL_Name, Excel_Adress, True, Excel_SheetName & "!"
End If
End Select
End If
Exit Function
ERR_INP_TBL:
If Err.Number = 3044 Then
MsgBox "Excelファイルのパス指定が誤っています。", vbCritical, "INP_TBL"
ElseIf Err.Number = 7874 Then '指定テーブルがない場合、テーブル削除のコードを飛ばして処理を行います
Resume Next
Else
MsgBox Error, vbCritical
End If
End Function