マクロ Excelデータ Accessへ

質問

マクロでExcelのデータでAccessにテーブルを作成する方法を教えていただけないでしょうか？

Accessに接続して加工したテーブルのデータをExcelにコピーすることはできたのですがExcelのデータをAccessにコピーするマクロがわかりません。

どなたかお知恵を拝借できないでしょうか。
よろしくお願いいたします。

回答No.10

山田 太郎（@f_a_007）

【補足】エクセルのデータをAccessにINSERTする一例

　全ては、添付図を眺めて下さい。

祈、奮闘！

回答No.9

山田 太郎（@f_a_007）

【補足】ロールバックバージョン

Public Function CnnExecute(ByVal strDB As String, _
　　　　　　　　　　　　　 ByVal strSQL As String) As Boolean
On Error GoTo Err_CnnExecute
　　'
　　' 【要参照設定】
　　'
　　' Micrsoft ActiveX Data Objects 2.8 Library
　　'
　　Dim isOK As Boolean
　　Dim DataValue
　　Dim cnn As ADODB.Connection

　　isOK = True

　　Set cnn = New ADODB.Connection
　　'
　　' データベース 　オープン
　　'
　　cnn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & strDB & ";"
　　With cnn
　　　　 .Errors.Clear
　　　　 .BeginTrans
　　　　 .Execute strSQL
　　　　 .CommitTrans
　　End With
Exit_CnnExecute:
On Error Resume Next
　　cnn.Close
　　Set cnn = Nothing
　　CnnExecute = isOK
　　Exit Function
Err_CnnExecute:
　　isOK = False
　　If cnn.Errors.Count > 0 Then
　　　　ErrMessage cnn.Errors(0), strSQL
　　　　cnn.RollbackTrans
　　Else
　　　　MsgBox "プログラムエラーが発生しました。" & _
　　　　　　　 "システム管理者に報告して下さい。(CnnExecute)", _
　　　　　　　 vbExclamation, " 関数エラーメッセージ"
　　End If
　　Resume Exit_CnnExecute
End Function

回答No.8

山田 太郎（@f_a_007）

【お詫び】ErrMessage()が欠落していました。

これが欠落していると発生したエラーを知ることができません。また、Execute 関数の場合は、ロールバックの仕組みは不可欠と思います。退院したので、取り敢えず欠落していたErrMessage()を補足します。

Public Sub ErrMessage(ByVal CnnErrors As ADODB.Error, ByVal strSQL As String)
　　MsgBox "ADOエラーが発生しましたので処理をキャンセルします。" & Chr$(13) & Chr$(13) & _
　　　　　"・Err.Description=" & CnnErrors.Description & Chr$(13) & _
　　　　　"・Err.Number=" & CnnErrors.Number & Chr$(13) & _
　　　　　"・SQL State=" & CnnErrors.SqlState & Chr$(13) & _
　　　　　"・SQL Text=" & strSQL, _
　　　　　vbExclamation, " ADO関数エラーメッセージ"
End Sub

回答No.7

m3_maki

No.6 です。

> Accessに接続して加工したテーブルのデータをExcelにコピーすることはできたのですがExcelのデータをAccessにコピーするマクロがわかりません。

ということだったので、それなりのスキルは有るものと考えたのですが、
意外と初心者だったのかな？

先の回答は
> こんな感じになります。
ということで、
あなたの環境でそのまま動くわけではありません。

シート名、データベース名（フルパス、拡張子）、テーブル名等
ご自分の環境に合わせて書き換える必要があります。

エラーメッセージからは
D:\Access\データベース1.accdb
のファイルが見つからないということでしょうから
この部分を書き換えてみてください。

> Accessに接続して加工したテーブルのデータをExcelにコピーすることはできたのですが

このコードを公開していただければ
もっと具体的な回答ができるかと。

範囲名に関しては
Excel の表に 「住所録」という範囲名を付けた場合、
SQL の [Sheet1$] の部分を[住所録] にする、ということです。
なお、範囲名でも、テーブル名としてマズい文字を使ってはいけません。

シート名でうまくいかない例。
スペース
かっこ
数字で始まる（例. 3月）
.# など特殊な文字
セルアドレスとぶつかる（例. A1 など）

補足

データベース名のみ修正済です。
それ以外は基のコードで実行できるようにセット済です。

やはり範囲SLECTでしょうか？
こちらは試しておりません。

Accessが入ってないPCに変更になったため、Excel　VBAで接続して作業を
したいと思っております。

できましたらコード見ていただけないでしょうか？
他にも分からないことがあるのですが相談に乗っていただくことは可能でしょうか？

不躾なお願いで申し訳ございません。
ご教授お願いします。

Sub マッチング()

Dim strFileName As String
strFileName = "test.accdb"

Dim adoCn As Object 'ADO
Set adoCn = CreateObject("ADODB.Connection")
adoCn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ThisWorkbook.Path & "\" & strFileName & ";"

Dim adoRs As Object
Set adoRs = CreateObject("ADODB.Recordset")

Dim strSQL As String
strSQL = "SELECT * FROM AA left outer join BB on (AA.名前=BB.名前)"

adoRs.Open strSQL, adoCn
Dim i As Integer
With Worksheets(1)
.Cells.ClearContents
For i = 1 To adoRs.Fields.Count
.Cells(1, i).Value = adoRs.Fields(i - 1).Name
Next
.Cells(2, 1).CopyFromRecordset adoRs
End With

adoRs.Close
adoCn.Close

Set adoRs = Nothing
Set adoCn = Nothing

End Sub

回答No.6

m3_maki

No.4 です。

こんな感じになります。
Sub Sample()
　Dim dbCon As New ADODB.Connection
　Dim strSQL As String

　' Connection生成
　With dbCon
　　.Provider = "Microsoft.ACE.OLEDB.12.0"
　　.Properties("Extended Properties") = "Excel 12.0"
　　.Open ThisWorkbook.FullName
　End With

　' SQL文作成 (テーブル作成クエリ)
　strSQL = "SELECT [Sheet1$].* INTO テーブル1 IN 'D:\Access\データベース1.accdb' FROM [Sheet1$]"

　'実行
　dbCon.Execute strSQL

　dbCon.Close: Set dbCon = Nothing
End Sub

シート名 によってはうまくいかないこともあるので
可能なら範囲名を使った方が安全かと思います。

補足

教えて頂いたコードで実行してみましたが下記のエラーが出ました。

実行時エラー　「-2147467259」
　　　　　　　　データベース1.accdb正しくないことと、パス名に間違いがないこと
　　　　　　　　ファイルが置かれたサーバーに接続していることを確認してください。

下記コードが黄色くなっております。
　　　　　　　　 dbCon.Execute strSQ

＞シート名 によってはうまくいかないこともあるので
＞可能なら範囲名を使った方が安全かと思います。

セルに名前をつけてSelectすると言うことでしょうか？

教えていただけないでしょうか。

回答No.5

山田 太郎（@f_a_007）

【手術前の第一弾】ExcelからAccessを操作する関数の紹介！

　添付図が示すように、Excel のイミディエイトウインドウから UPDATE文を発行することでAccessの顧客台帳を更新しています。単に Cnn.EXECUTE を実行するだけの超簡単な関数。非実用的ですが、あっても邪魔にはならない関数の一つです。もちろん、Excel の表からSELECTしたデータを元にAceessのテーブルを更新する関数は、先に述べたような仕様になります。

Public Function CnnExecute(ByVal strDB As String, _
　　　　　　　　　　　　　 ByVal strSQL As String) As Boolean
On Error GoTo Err_CnnExecute
　　'
　　' 【要参照設定】
　　'
　　' Micrsoft ActiveX Data Objects 2.8 Library
　　'
　　Dim isOK As Boolean
　　Dim DataValue
　　Dim cnn As ADODB.Connection

　　isOK = True

　　Set cnn = New ADODB.Connection
　　'
　　' データベース 　オープン
　　'
　　cnn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & strDB & ";"
　　With cnn
　　　　 .Errors.Clear
　　　　 .BeginTrans
　　　　 .Execute strSQL
　　　　 .CommitTrans
　　End With
Exit_CnnExecute:
On Error Resume Next
　　cnn.Close
　　Set cnn = Nothing
　　CnnExecute = isOK
　　Exit Function
Err_CnnExecute:
　　isOK = False
　　MsgBox "SQL 文の実行時にエラーが発生しました。(CnnExecute)" & Chr$(13) & Chr$(13) & _
　　　　　 "・Err.Description=" & Err.Description & Chr$(13) & _
　　　　　 "・SQL Text=" & strSQL, _
　　　　　 vbExclamation, " 関数エラーメッセージ"
　　Resume Exit_CnnExecute
End Function

回答No.4

m3_maki

> マクロでExcelのデータでAccessにテーブルを作成する方法を教えていただけないでしょうか？

１．すでにある Access のテーブルに Excel のデータをコピーする。
２．Excel の表と同じ構造のテーブルをで新規に作成し、データも設定する。

どちらの意味で仰っていますか？

補足

2です。

回答No.3

山田 太郎（@f_a_007）

【補足】もう一つだけ。

　DBSelect()で取得したデータは、変数には２億文字は格納できる。が、それをセルで受け取るには限界があります。ちょいと長いデータになると、尻切れトンボになるのは必定。ですから、最初の添付図で示した関数をもう一つ用意する必要があります。

理由：Access と Excel では型の考え方が違う。

　ですから、Integer型、Single型等を Excel のそれに変換してシートに書き込む必要があります。つまり、Access用の SheetUpdate()が必要になる訳です。シートからシートへのコピペする関数は、そのまんまでは通用しないってことです。ですから、Access⇒Excel を完全に実現するのは、Access用の SheetUpdate()は必須です。

　以上、補足しておきます。

回答No.2

山田 太郎（@f_a_007）

【補足】DBSExecute()とDBSWrite()の二つを書いてもいいが・・・

　明日は、再度の手術入院。退院は、翌日。それから、おっちらおっちらと書き始めて3～5日はかかると思います。で、その二つを書いて提供する前に、現状のExcelからAccessを参照する関数の打ち合わせが必要かと・・・。どっちにしろ、以下に紹介する関数がベースですから・・・。なお、この二つの関数の働きは添付図で確認されて下さい。コードは、コピペ段階で関数名を変更したので、変更もれがあるやも。が、そのバグを修正すれば動きます。たった、今、動かしてスクリーンショットを撮ったので。では、一緒に、開発するかどうかの返事を待っています。

Option Explicit

Public Function DBLookup(ByVal strDB As String, ByVal strSQL As String) As String
On Error GoTo err_DBLookup:
　　Dim cnn As Object 'ADOコネクションオブジェクト
　　Dim rst As Object 'ADOレコードセットオブジェクト

　　' ---------------
　　'　Set
　　' ---------------
　　Set cnn = CreateObject("ADODB.Connection")
　　Set rst = CreateObject("ADODB.Recordset")
　　'
　　' データベース 　オープン
　　'
　　cnn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & strDB & ";"
　　' ----------------------------------------
　　'　レコードセット　オープン
　　' ----------------------------------------
　　With rst
　　　　.Open strSQL, cnn
　　　　If Not .BOF Then
　　　　　　.MoveFirst
　　　　　　DbmLookup = .Fields(0)
　　　　Else
　　　　　　DbmLookup = ""
　　　　End If
　　End With
Exit_DBLookup:
On Error Resume Next
　　rst.Close
　　cnn.Close
　　Set rst = Nothing
　　Set cnn = Nothing
　　Exit Function
err_DBLookup:
　　MsgBox Err.Description
　　Resume Exit_DBLookup
End Function

Public Function DBSelect(ByVal strDB As String, _
　　　　　　　　　　　　 ByVal strSQL As String, _
　　　　　　　　　　　　 Optional colDelimita As String = ";", _
　　　　　　　　　　　　 Optional rowDelimita As String = ";") As String
On Error GoTo Err_DBSelect
　　Dim cnn As Object 'ADOコネクションオブジェクト
　　Dim rst As Object 'ADOレコードセットオブジェクト
　　Dim fld As Object 'ADOフィールドオブジェクト
　　Dim strWhere　　As String
　　Dim strList　　 As String　' 全てのデータを区切子で連結して格納
　　Dim strCountSQL As String

　　' ---------------
　　'　Set
　　' ---------------
　　Set cnn = CreateObject("ADODB.Connection")
　　Set rst = CreateObject("ADODB.Recordset")
　　'
　　' データベース 　オープン
　　'
　　cnn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & strDB & ";"
　　'adoCn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & strDB
　　' ----------------------------------------
　　'　レコードセット　オープン
　　' ----------------------------------------
　　With rst
　　　　.Open strSQL, cnn
　　　　If Not .BOF Then
　　　　　　.MoveFirst
　　　　　　Do
　　　　　　　　For Each fld In .Fields
　　　　　　　　　　With fld
　　　　　　　　　　　　strList = strList & .Value & colDelimita
　　　　　　　　　　End With
　　　　　　　　Next fld
　　　　　　　　strList = Mid(strList, 1, Len(strList) - 1) & rowDelimita
　　　　　　　　　　 .MoveNext
　　　　　　Loop Until (.EOF)
　　　　Else
　　　　　　strList = ""
　　　　End If
　　End With
Exit_DBSelect:
On Error Resume Next
　　rst.Close
　　Set rst = Nothing
　　DbmSelect = IIf(Len(strList) > 0, Replace(strList & "[END]", rowDelimita & "[END]", ""), "")
　　Exit Function
Err_DBSelect:
　　MsgBox Err.Description
　　Resume Exit_DBSelect
End Function

回答No.1

山田 太郎（@f_a_007）

Q1、ExcelからAccessを操作する方法とは？
A1、マクロでは無理でしょう。

《Accessにテーブルを作成する方法》

　Access のテーブルを作成する上で、ある意味で推奨されている方法です。

・イクセルでテーブルの設計書を書く。
・その設計書で、テーブルを生成する。

　これで、後輩、同僚に《テーブルの設計書》を残せます。で、これを実現するには、《テーブル管理ツール》を開発する必要があります。エクセルから、DELETE文、UPDATE文、INSERT文を発行してAccessのテーブルを削除、更新、挿入するのは、関数一発。でも、そういうSQL文の世界とは全く違います。開発者レベルのツールの開発ですよ。まあ、普通は、ここんところは、最初に学ぶことです。

Q2、ExcelのデータをAccessにコピーする。
A2、これは、ある意味で簡単に実現できます。

　が、幾つか解決すべき問題があります。それは、列データの Type の考え方が（どうやら）両者では違うようです。SQL ServerとAccessでやり取りする手法は、通じないようです。まあ、昨日から、この問題でスッタモンダしています。

＞ExcelのデータをAccessにコピーするマクロ。
＞どなたかお知恵を拝借できないでしょうか？

　これを、たった一つの関数で実現するには、添付図のような仕掛けになると思いますよ。

＞SQLWrite(SQL文、[エクセルシート名])
　↓
＞DBMLWrite(SQL文、[Accessテーブル名])

Public Function SQLWriter(ByVal strSQL As String, _
　　　　　　　　　　　　ByVal strSheetName As String, _
　　　　　　　　　　　　Optional xlFileName As String = "", _
　　　　　　　　　　　　Optional isHeader As Boolean = True) As Boolean
　　Dim strList As String

　　strList = DSelect(strSQL, ";", "|", xlFileName, isHeader)
　　If ChrCount(strList, "|") <> 0 Then
　　　　SQLWriter = SheetUpdate(strList, strSheetName)　
　　Else
　　　　Message "SQLWriter() は、単行の書き込みはサポートしていません！"　　　
　　End If
End Function

　で、書くべき関数は、次のようです。

SheetUpdate(strList, strSheetName)
　↓
TableUpDate(strList, strTableName)

　さて、これで添付図と同じことが実現します。が、こういう関数を書く基礎知識は、ADODB のヘルプ文を紐解くのが王道でしょう。

PS、エクセルから、SQL文を発行してAccessのテーブルを更新する。

　これは、単に

DoCmd.RunSQL

と同じ働きをする関数を書くだけです。