アメビン
- Excelシートの情報をデータベースに追加したい
- データベースの情報をExcelシートに貼り付けたい
こんな悩みを解決します。
最後まで読んで頂き、実践して、ここへ来なくなった頃には、
あなたはスキルアップしている事でしょう。
さて、この記事の題目は
ExcelVBA「Accessデータベース連携」弱小エンジニアのやり方
アメビン
このサイトを運営している私は、
製造業でのCAD設計歴20年以上のエンジニアです。
Excelを使って業務効率化もしています。
Accessデータベース連携する為の準備
前編-1限目：Accessデータベース連携する為の変数定義
ある日の社内チャットのやり取り
困ったアメビン
Excelシートの情報をデータベースに追加できるの？
めがね後輩
出来ますよ！
とりあえずデータベースに接続をするところから知らないとですね
まずは、データベースのパス用変数、接続用オブジェクト変数、
抽出用オブジェクト、データベース言語用変数を定義しましょう
あと、使い回せる様にパブリックにします
|
1 2 3 4 5 6 7 8 9 10 11 12 13 |
Option Explicit 'データーベースのパス Public DbPath As String 'Connectionオブジェクト(ADO) Public CoAdo As Object 'Recordsetオブジェクト(ADO) Public ReAdo As Object 'データベース言語(SQL) Public StrSql As String |
困ったアメビン
お、おう・・・解らない
前編-2限目：Accessデータベース接続する為のコード
困ったアメビン
データベースはAccessだけど大丈夫？
めがね後輩
問題ありません！
今回は同一フォルダ内にAccessデータベースがある場合で解説します
2007以前と以降で拡張子とProviderのコードが違うので注意してください
2007以前も記載してコメントアウトしておきます
サンプルコードを送ります
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 |
Sub DbConnection() 'データーベース接続 'データーベースのパス※ActiveWorkbook.Path = 同じフォルダ内 DbPath = ActiveWorkbook.Path & "\データベース名.mdbかaccdb" 'Connectionオブジェクト(ADO)を作成 Set CoAdo = CreateObject("ADODB.Connection") 'Recordsetオブジェクト(ADO)を作成 Set ReAdo = CreateObject("ADODB.Recordset") 'Access（～2003）を開く 'CoAdo.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & DbPath & ";" 'Access（2007～）を開く CoAdo.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & DbPath & ";" End Sub |
困ったアメビン
お、おう・・・全然解らない
前編-3限目：Accessデータベース切断する為のコード
困ったアメビン
理解するのに時間がかかるから
とりあえずサンプルコードをコピペしておくか
実際データベースに追加するにはどうすれば？
めがね後輩
まだ終わってませんよ！
処理が終わったら切断も必要です
サンプルコードを送ります
|
1 2 3 4 5 6 7 8 9 10 11 12 13 |
Sub DbDisconnection() 'データーベース切断 'Recordsetを閉じる（読込限定） ReAdo.Close 'Connectionを閉じる CoAdo.Close 'オブジェクトを空にする Set ReAdo = Nothing Set CoAdo = Nothing End Sub |
困ったアメビン
お、おう・・・これはなんとなく解った
接続したまま終われないって事か
Accessデータベースに追加する
中編-1限目：データベースの箱を用意する
困ったアメビン
次はデーターベースの箱の用意か
めがね後輩
はい！
ではAccessのデータベースの箱を作ります
バージョンによって違いがありますが
「新規作成」の「デザインビュー」で作成するか
「デザインビューでテーブルを作成する」をダブルクリックでも作成できます
めがね後輩
次にフィールド名を「ID」で「オートナンバー型」
フィールド名は「品番」「メーカー」「担当」等の任意で
データ型は「テキスト型」や「数値型」にします
他にも細かい設定がありますが、まずは動かすという事で割愛します
めがね後輩
「ID」のフィールドの左のところで右クリックをして
「主キー」を選択してください
鍵のマークが付きます
めがね後輩
保存します
テーブルなので「T_＊＊＊」って付けるのが多いみたいです
めがね後輩
Excelシートに同じフィールド名でリストを作成してください
あと、ボタンを配置するので上の行は空けておいてください
困ったアメビン
こんな感じでいいかな
中編-2限目：見積追加（複数）
めがね後輩
サンプルコードを送ります
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 |
Option Explicit Sub Estimate_Add_Multi() '業務追加 Dim rng As Range Dim LocX As Long '座標X Dim LocY As Long '座標Y Dim PNum As String '品番 Dim ECNum As Long '設番 Dim Component As String '品目 Dim Spec As String '仕様 Dim Material As String '材質 Dim Manufacturer As String '製造 Dim Supplier As String '手配 Dim Note As String '備考 Dim Cost As String '費用 Dim ArrangementDate As String '手配日 Dim DeliveryDate As String '納品日 Dim ws As Worksheet Set ws = Worksheets("見積管理") LocX = Selection(1).Column LocY = Selection(1).Row '選択したセル範囲を全てループ For Each rng In Selection LocX = rng.Column LocY = rng.Row If LocX = 7 And LocY >= 11 Then '満たしていればスルー Else MsgBox "品目の列を選択してください" Exit Sub End If If ws.Cells(LocY, 5) = "" Then MsgBox "品番が入力されていません" Exit Sub End If PNum = ws.Cells(LocY, 5) '品番 '設番が未記入の場合は0とする If ws.Cells(LocY, 6) = "" Then ws.Cells(LocY, 6) = 0 End If ECNum = ws.Cells(LocY, 6) '設番 Component = ws.Cells(LocY, 7) '品目 Spec = ws.Cells(LocY, 8) '仕様 Material = ws.Cells(LocY, 9) '材質 Manufacturer = ws.Cells(LocY, 10) '製造 Supplier = ws.Cells(LocY, 11) '手配 Note = ws.Cells(LocY, 12) '備考 '費用が未記入の場合は0とする If ws.Cells(LocY, 13) = "" Then ws.Cells(LocY, 13) = 0 End If Cost = ws.Cells(LocY, 13) '費用 ArrangementDate = ws.Cells(LocY, 14) '手配日 DeliveryDate = ws.Cells(LocY, 15) '納品日 'SQL文・・・INSERT INTO StrSql = "INSERT INTO T_見積管理(品番,設番,品目,仕様,材質,製造,手配,備考,費用,手配日,納品日) " & _ "VALUES('" & PNum & "'," & ECNum & ",'" & Component & "','" & Spec & "','" & Material & "','" & _ Manufacturer & "','" & Supplier & "','" & Note & "'," & Cost & ",'" & ArrangementDate & "','" & DeliveryDate & "')" 'DB接続・書込・切断 Call DbConnect CoAdo.Execute StrSql CoAdo.Close Set CoAdo = Nothing Next ' Call Task_Read MsgBox "見積情報を追加しました" End Sub |
困ったアメビン
工事中です
中編-3限目：見積修正（複数）
めがね後輩
サンプルコードを送ります
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 |
Option Explicit Sub Estimate_Fix_Multi() '見積修正（複数） Dim rng As Range Dim LocX As Long '座標X Dim LocY As Long '座標Y Dim ID As Long 'ID Dim PNum As String '品番 Dim ECNum As Long '設番 Dim Component As String '品目 Dim Spec As String '仕様 Dim Material As String '材質 Dim Manufacturer As String '製造 Dim Supplier As String '手配 Dim Note As String '備考 Dim Cost As String '費用 Dim ArrangementDate As String '手配日 Dim DeliveryDate As String '納品日 Dim ws As Worksheet Set ws = Worksheets("見積管理") LocX = Selection(1).Column LocY = Selection(1).Row '選択したセル範囲を全てループ For Each rng In Selection LocX = rng.Column LocY = rng.Row If LocX = 7 And LocY >= 11 Then '満たしていればスルー Else MsgBox "品目の列を選択してください" Exit Sub End If If ws.Cells(LocY, 5) = "" Then MsgBox "品番が入力されていません" Exit Sub End If 'IDが未記入の場合は終了とする If ws.Cells(LocY, 4) = "" Then MsgBox "IDのある列を選択してください" Exit Sub End If ID = ws.Cells(LocY, 4) PNum = ws.Cells(LocY, 5) '品番 '設番が未記入の場合は0とする If ws.Cells(LocY, 6) = "" Then ws.Cells(LocY, 6) = 0 End If ECNum = ws.Cells(LocY, 6) '設番 Component = ws.Cells(LocY, 7) '品目 Spec = ws.Cells(LocY, 8) '仕様 Material = ws.Cells(LocY, 9) '材質 Manufacturer = ws.Cells(LocY, 10) '製造 Supplier = ws.Cells(LocY, 11) '手配 Note = ws.Cells(LocY, 12) '備考 '費用が未記入の場合は0とする If ws.Cells(LocY, 13) = "" Then ws.Cells(LocY, 13) = 0 End If Cost = ws.Cells(LocY, 13) '費用 ArrangementDate = ws.Cells(LocY, 14) '手配日 DeliveryDate = ws.Cells(LocY, 15) '納品日 'SQL文・・・UPDATE StrSql = "UPDATE T_見積管理 SET 品番 = '" & PNum & "' , 設番 = '" & ECNum & _ "' , 品目 = '" & Component & "' , 仕様 = '" & Spec & "' , 材質 = '" & Material & _ "' , 製造 = '" & Manufacturer & "' , 手配 = '" & Supplier & "' , 備考 = '" & Note & _ "' , 費用 = '" & Cost & "' , 手配日 = '" & ArrangementDate & "' , 納品日 = '" & DeliveryDate & _ "' WHERE ID = " & ID 'DB接続・書込・切断 Call DbConnect CoAdo.Execute StrSql CoAdo.Close Set CoAdo = Nothing Next Call Estimate_Read MsgBox "見積情報を修正しました" End Sub |
困ったアメビン
ややこしいけど
なんとなく理解した
工事中です
後編-1限目：工事中です
困ったアメビン
工事中です
めがね後輩
工事中です
困ったアメビン
工事中です
後編-2限目：工事中です
困ったアメビン
工事中です
めがね後輩
工事中です
|
1 |
工事中です |
困ったアメビン
工事中です
後編-3限目：工事中です
困ったアメビン
工事中です
めがね後輩
工事中です
|
1 |
工事中です |
困ったアメビン
工事中です
アメビン
これにておしまいです
今後もVBAの知識を深めていきたいと思います
ご教授いただきありがとうございました
コメント