Sub d1_mysql抽出uriage2()
Sheets("売上").Select
Range("m1:o11").ClearContents
Range("s1:t11").ClearContents
Dim i As Long
Dim mySQL As String
Call a02_InODBC
For ii = 1 To 2
Select Case ii
Case 1
mySQL = "select key1,ngp,kikai from uriage2" & _
" where ngp = " & Sheets("売上").Range("l5").Value & "" & _
" and kikai = '" & Sheets("売上").Range("l7").Value & "'" & _
" order by key1 ASC"
Set rs = cn.Execute(mySQL)
With rs
'フィールド名
For i = 1 To .Fields.Count
Cells(1, i + 12).Value = .Fields(i - 1).Name
'行1,列13に抽出
Next
'レコード
Range("m2").CopyFromRecordset rs
End With
Case 2
mySQL = "select renban,uriko from uriage2" & _
" where ngp = " & Sheets("売上").Range("l5").Value & "" & _
" and kikai = '" & Sheets("売上").Range("l7").Value & "'" & _
" order by key1 ASC"
Set rs = cn.Execute(mySQL)
With rs
'フィールド名
For i = 1 To .Fields.Count
Cells(1, i + 18).Value = .Fields(i - 1).Name
'行1,列13に抽出
Next
'レコード
Range("s2").CopyFromRecordset rs
End With
End Select
Next
Call a09_OutODBC
End Sub
Public Sub d3_mysql更新uriage2()
Dim SelCmd As String '選択用のSQLステートメント
Dim DelCmd As String '削除用のSQLステートメント
Dim n As Integer '注文明細の個数
Dim i As Integer 'カウンタ
'データベースの接続
Call a02_InODBC
'画面を固定
Application.ScreenUpdating = False
'テーブルから既存のデータを削除
MsgBox Range("l5").Value & " を一旦削除して、再登録します。"
DelCmd = "DELETE FROM uriage2 WHERE ngp ='" & Range("l5").Value & "'" & _
"and kikai ='" & Range("l7").Value & "'"
cn.Execute DelCmd
For ii = 1 To 1
Select Case ii
Case 1
'入力したデータ数を調べる
n = Application.WorksheetFunction.CountA(Range("s2:s11"))
If n = 0 Then
MsgBox "データがありません。", vbOKOnly, "終了"
Exit Sub
End If
'新規登録
SelCmd = "SELECT * FROM uriage2"
rs.Open SelCmd, cn, adOpenKeyset, adLockOptimistic
For i = 0 To n - 1
rs.AddNew
rs!key1 = Range("m" & 2 + i).Value
rs!ngp = Range("n" & 2 + i).Value
rs!kikai = Range("o" & 2 + i).Value
rs!com = Range("p" & 2 + i).Value
rs!Name = Range("q" & 2 + i).Value
rs!uritan = Range("r" & 2 + i).Value
rs!renban = Range("s" & 2 + i).Value
rs!uriko = Range("t" & 2 + i).Value
rs!uriage = Range("u" & 2 + i).Value
rs.Update
Next i
MsgBox Chr(13) & "総数" & i, vbOKOnly, "登録"
End Select
Next
'後処理
Call a09_OutODBC
MsgBox "既存データの更新完了" & Chr(13) & "確認して下さい。", vbOKOnly, "成功です"
'画面の固定を解除
Application.ScreenUpdating = True
End Sub