'-------------------------

Private Sub Excelインポート_Click()

On Error GoTo Err_追加_Click

'エクセルからの送付リスト追加

Dim 保存先 As String

Dim 日付 As String

Dim strSource As String

Dim ファイル名 As String

Dim str確認 As String

保存先 = "C:\試験\"

日付 = Replace(Me.日付, "/", "")

strSource = "テーブル"

ファイル名 = 保存先 & strSource & 日付 & ".xls"

'ファイルの存在確認

If Dir(ファイル名) = "" Then

  str確認 = "インポートするファイルがありません。" _

  & Chr(13) & Chr(13) & 保存先 & "　ファルダにて" _

  & Chr(13) & "ファイル名を　「" & strSource & 日付 & ".xls" & "」　としてください。"

  MsgBox str確認, vbExclamation, "ご確認ください"

  Exit Sub

End If

'削除クエリ

  DoCmd.SetWarnings False

  DoCmd.RunSQL "DELETE FROM テーブル追加用"

  DoCmd.RunSQL "DELETE FROM テーブル"

'インポートする

  DoCmd.TransferSpreadsheet acImport, , "テーブル追加用", ファイル名, True, ""

  DoCmd.SetWarnings True

' 追加クエリを実行します。

  DoCmd.OpenQuery "追加クエリ"

  Me.Refresh

  MsgBox "完了しました。", 64, "インポート"

Exit_追加_Click:

  Exit Sub

Err_追加_Click:

  MsgBox "Excelシートの項目の無い列にデータがある可能性があります。" &

Chr(13) & Chr(13) & Err.Description, 16

  Resume Exit_追加_Click

end sub