If Combo1.Text = "" Then
		MsgBox ("コースを選択して下さい")
		Exit Sub
	End If
	
	' ----------------------------------------------------
	' Connection オブジェクト作成
	Set OpenDB = CreateObject("ADODB.Connection")
	
	' ----------------------------------------------------
	' 接続文字列作成
	strConnection = _
		"Provider=Microsoft.Jet.OLEDB.4.0;" & _
		"Data Source=" & App.Path & "\調査票.mdb;"

	' ----------------------------------------------------
	' DB 接続
	On Error Resume Next
	OpenDB.Open strConnection
	If Err.Number <> 0 Then
		Set OpenDB = Nothing
		MsgBox (Err.Description)
		Exit Sub
	End If
	On Error GoTo 0

	' ----------------------------------------------------
	' Recordset オブジェクト作成
	Set rs = CreateObject("ADODB.Recordset")
	
	' ----------------------------------------------------
	' SQL 文字列作成
	SqlQuery = "select * from リスト " & " where コース = '" & Combo1.Text & "'"
	SqlQuery = SqlQuery & " order by コード"

	' ----------------------------------------------------
	' Recordset 取得
	rs.Open SqlQuery, OpenDB
	
	If rs.EOF Then
		rs.Close
		Set rs = Nothing
		OpenDB.Close
		Set OpenDB = Nothing
		MsgBox ("対象データが存在しませんでした")
		Exit Sub
	End If

	' ----------------------------------------------------
	' Excel アプリケーションオブジェクト作成
	Set ExcelApp = CreateObject("Excel.Application")
	
	' ----------------------------------------------------
	' Excel を表示させる
	ExcelApp.Visible = True
	
	' ベースBook を開く
	Set MyBook = ExcelApp.Workbooks.Open(App.Path & "\" & Combo1.Text & ".xls")

	Dim i, j, k As Integer
	Dim v As String
	
	Do While Not rs.EOF

		Me.Refresh
		
		' ベースSheet を選択
		On Error Resume Next
		MyBook.Sheets(rs.Fields("コード").Value & "").Select
		If Err.Number <> 0 Then
		Else
			For i = 1 To 20
				If MyBook.ActiveSheet.Cells(2, i + 1).Value = "" Then
					Exit For
				End If
				SqlUpdate = "insert into 調査結果 (コード1,コード2) values(" _ 
					& rs.Fields("コード").Value & "," _
					& MyBook.ActiveSheet.Cells(2, i + 1).Value _
					& ")"
				OpenDB.Execute SqlUpdate
				If Err.Number = 0 Then
					For k = 1 To 14
						v = MyBook.ActiveSheet.Cells(3 + k, i + 1).Value
						If v & "*" = "*" Then
							v = "NULL"
						End If
						SqlUpdate = "update 調査結果 set 調査" _
							& k & " = " & v & " where コード1 = " _
							& rs.Fields("コード").Value _
							& " and コード2 = " _
							& MyBook.ActiveSheet.Cells(2, i + 1).Value
						OpenDB.Execute SqlUpdate
					Next
				End If
			Next
		End If
		On Error GoTo 0

		' 次データの読込み
		rs.MoveNext

	Loop

	MyBook.Close
	ExcelApp.Quit

	rs.Close
	Set rs = Nothing
	OpenDB.Close
	Set OpenDB = Nothing