ACCESS への複数ファイルのインポートマクロ

こんにちは、ACCESSへのエクセルデータのインポートのマクロについて教えて頂けませんか？

大量のファイルがあり、どれも同じ形式、同じフィールド名で保存してあります（xlsx形式）

これを自動でインポートするマクロはどのようなものになるでしょうか？

ファイル名は連番になっておらず、同じフォルダ内にあります。
また、テーブル名はマクロ内で随時指定したいと思っています。

aaa.xlsxをインポート定義を反映させテーブル名を指定してインポート
bbb.xlsxをインポート定義を反映させテーブル名を指定してインポート
・
・
・
・
みたいな感じです。

詳しい方教えて頂けませんでしょうか。
よろしくお願いいたします。

質問者からの補足コメント

• あ、解りにくい書き方でしたね　定義ファイルを2か所変更してあと標準モジユール　クラスの説明をしました、

    補足日時：2020/02/01 00:45

No.7 回答者： よろずやkinchan 回答日時： 2020/02/02 09:21

こちらのテストでは問題ないので、迷宮入りかも。

そちらで何をしているのか、そばで見ている訳ではないので...

＞エラー380って、プロパティ値のエラーなんですね。
If objIES Is Nothing Then
Err.Raise 380, ClassName, "Let ImpExpName で ImportExportSpecification がありません"
End If
ここに 380 って書いたから 380 になっただけのことです。
（数値はなんでもいいが、380 がよかろうってことで）

＞ファイルのパスも自動で取得するって事は
自動ではありません。
インポート定義を作ったときに記憶されたパスを取り出しているだけです。

この回答へのお礼

なるほど、ありがとうございます。

かなり効率的な上級者の方のコードなんですね、気づけずに済みません。

＞＞こちらのテストでは問題ないので、迷宮入りかも。
と言う事で、なにかこう当方の根本的なところに問題があるのかも知れませんね。

いろいろ考えてみます。

大変手間をかけて頂き、感謝いたします、ありがとうございます。

お礼日時：2020/02/02 09:58

No.6 回答者： よろずやkinchan 回答日時： 2020/02/02 07:19

objIES.ImpExpName = "aaa"

↓ 試しに書き換えてみてください。
objIES.ImpExpName(CodeProject) = "aaa"

この回答へのお礼

ありがとうございます。

エラー380って、プロパティ値のエラーなんですね。
http://www.kitagawa-hanga.com/se/s_vberr.html#E0 …

一応すべてのコードを半角に変換して張り付けてみましたが、同じエラーが出るようです。
また管理者として実行もやってみましたが同じ様子。

Source=ImpExpSpec,ErrNo=380,Description=LetImpExpNameでImportExportSpecification




素朴な疑問なんですが、ファイルのパスも自動で取得するって事は、ファイルの置き場所はPC内であればどこでも良いのでしょうか？

もしそうであれば、xlsxファイルをすべて読みに行っちゃうのですか？

ダミーデータを一つ作ってそれを読ませようかなと思ったのですが、ダメですかね？

お礼日時：2020/02/02 09:03

No.5 回答者： よろずやkinchan 回答日時： 2020/02/01 20:25

下記プロシージャに１行追加してください。

' インポート／エクスポート定義の名前
Property Let ImpExpName(Optional CodeProject As CodeProject, ImpExpName As String)
On Error Resume Next
If CodeProject Is Nothing Then
Set objIES = CurrentProject.ImportExportSpecifications(ImpExpName)
Else
Set objIES = CodeProject.ImportExportSpecifications(ImpExpName)
End If
On Error GoTo 0 ' ←←←←←←←←←←←←←←←←←←←←←←←←←←これを追加
If objIES Is Nothing Then
Err.Raise 380, ClassName, "Let ImpExpName で ImportExportSpecification がありません"
End If
End Property

＞Source=ImpExpSpec,ErrNo=419,Description=GetPathでImportExportSpecificationがありません。
インポート定義の名前が違っています。

この回答へのお礼

再回答いただき　ありがとうございます。

当方の間違いがあってはいけないので　' インポート／エクスポート定義の標準モジュールのコードをまるっと入れ替えしました。

そしてインポート定義もaaaと言う間違いの無さそうなものに変え、実際にファイルを一つ読み込んで動作することを確認してaaaに書き換えましたが、エラーメッセージが出てしまうようです。

Source=ImpExpSpec,ErrNo=380,Description=LetImpExpNameでImportExportSpecificationがありません。

となっています。

お礼日時：2020/02/01 22:19

No.4 回答者： よろずやkinchan 回答日時： 2020/01/31 13:03

＞"インポート-定義" と書いてある所を実際のインポート定義の名前に書き換えてください。

これは書き換えしましたか？

この回答へのお礼

はい、2か所書き換えました。

左のプロジェクトのところには
〇〇データベース
　標準モジュール
　　module1

クラスモジュール
　　ImpExpSpec

となっています。

ちなみに定義ファイルは実際に動作するか確認してみました。
検索で探してみたんですが、よくわからないんです＞＜

お礼日時：2020/01/31 22:12

No.3 回答者： よろずやkinchan 回答日時： 2020/01/31 11:22

コンパイルはできましたか？

Dim objIES As ImpExpSpec ←がエラーになるようなら、クラスモジュールの名前が違うということです。
クラスモジュールのプロパティの (オブジェクト名)の欄の Class1 の所を ImpExpSpec に書き換えてください。
＞マクロ名の欄に何も表示されていない
エクセルの場合は、VBAで書いたサブプロシージャ名がマクロ名の欄に出てきますが、アクセスの場合はVBAとマクロは全くの別物です。マクロはVBAとは別の言語です。
とりあえずはVBEの画面からF8キーF5キーで実行してみましょう。
最終的には、フォームの実行ボタンから呼び出す形になります。

この回答へのお礼

再回答いただき　ありがとうございます。

コンパイルが必要なんですね、やってみました。
エラーが出たのでImpExpSpecに書き換えたらエラーが出なかったのでコンパイル出来たようです。（コンパイル完了とか出ないんですね）

モジュールのところにはImpExpSpecともうひとつModule１とでています。

F5でマクロのダイアログボックスが開いて　Sampleが表示されていて選択して実行・・・したのですが、エラーメッセージが出ています。

Source=ImpExpSpec,ErrNo=419,Description=GetPathでImportExportSpecificationがありません。

となってます。

ちょっと検索して原因を調べてみます。

ありがとうございます。

お礼日時：2020/01/31 12:48

No.2 回答者： よろずやkinchan 回答日時： 2020/01/30 21:54

' 標準モジュール ～ ' クラス モジュール の前までを 標準モジュール に記述します。

' クラス モジュール 以降を クラス モジュール に記述します。
ファイルのパス は、インポート定義から取得しています。
"インポート-定義" と書いてある所を実際のインポート定義の名前に書き換えてください。
100個くらいのファイル は、DIR関数で取得しています。
テーブル名は、ファイル名から拡張子を除いたものにしていますので、そちらのネーミングルールに書き換えてください。
Split(FileName, ".")(0) ←がファイル名から拡張子を除いている箇所です。

この回答へのお礼

こんにちは、クラスモジュールまでのコードの追加が出来たのでマクロを実行したのですが、マクロ名の欄に何も表示されていないみたいなのですが、これはなんででしょうか？

実際に動作させるには、違う方法なのでしょうか、お手数ですが教えて頂けませんでしょうか。

お礼日時：2020/01/31 09:15

No.1 回答者： よろずやkinchan 回答日時： 2020/01/30 11:07

' 標準モジュール

Option Compare Database
Option Explicit

Sub Sample()
Dim objIES As ImpExpSpec, Path As String, FileName As String
On Error GoTo Err_Proc
Set objIES = New ImpExpSpec
objIES.ImpExpName = "インポート-定義"
Path = objIES.Path
If Right(Path, 1) <> "\" Then Path = Path & "\"
FileName = Dir(Path & "*.xlsx", vbNormal)
Do Until Len(FileName) = 0
objIES.FileName = FileName
objIES.Destination = Split(FileName, ".")(0)
DoCmd.RunSavedImportExport "インポート-定義"
FileName = Dir()
Loop
Exit_Proc:
Set objIES = Nothing
Exit Sub
Err_Proc:
MsgBox "Source=" & Err.Source & ", ErrNo=" & Err.Number & ", Description=" & Err.Description
Resume Exit_Proc
End Sub

' クラス モジュール
Option Compare Database
Option Explicit
Const ClassName = "ImpExpSpec"
Const FindText1 = "<ImportExportSpecification Path = """
Const FindText4 = "Destination="""
Private objIES As ImportExportSpecification

' インポート／エクスポート定義の名前
Property Let ImpExpName(Optional CodeProject As CodeProject, ImpExpName As String)
On Error Resume Next
If CodeProject Is Nothing Then
Set objIES = CurrentProject.ImportExportSpecifications(ImpExpName)
Else
Set objIES = CodeProject.ImportExportSpecifications(ImpExpName)
End If
If objIES Is Nothing Then
Err.Raise 380, ClassName, "Let ImpExpName で ImportExportSpecification がありません"
End If
End Property

' インポート／エクスポートするファイルのパス
Property Get Path() As String
Dim strXML As String, pos1 As Long, pos2 As Long
If objIES Is Nothing Then
Err.Raise 419, ClassName, "Get Path で ImportExportSpecification がありません"
Else
strXML = objIES.XML
pos1 = InStr(1, strXML, FindText1)
If pos1 > 0 Then
pos1 = pos1 + Len(FindText1)
pos2 = InStrRev(strXML, "\", InStr(pos1, strXML, """"))
Path = Mid(strXML, pos1, pos2 - pos1)
If Right(Path, 1) = ":" Then Path = Path & "\"
End If
End If
End Property

' インポート／エクスポートするファイルのファイル名
Property Let FileName(FileName As String)
Dim strXML As String, pos1 As Long, pos2 As Long
If objIES Is Nothing Then
Err.Raise 419, ClassName, "Let FileName で ImportExportSpecification がありません"
Else
strXML = objIES.XML
pos1 = InStr(1, strXML, FindText1)
If pos1 = 0 Then
Err.Raise 51, ClassName, "Let FileName で Path がありません"
Else
pos2 = InStr(pos1 + Len(FindText1), strXML, """")
pos1 = InStrRev(strXML, "\", pos2)
objIES.XML = Left(strXML, pos1) & FileName & Mid(strXML, pos2)
End If
End If
End Property

' インポートで作成するテーブル
Property Let Destination(Destination As String)
Dim strXML As String, pos1 As Long, pos2 As Long
If objIES Is Nothing Then
Err.Raise 419, ClassName, "Let Destination で ImportExportSpecification がありません"
Else
strXML = objIES.XML
pos1 = InStr(1, strXML, FindText4)
If pos1 = 0 Then
Err.Raise 51, ClassName, "Let Destination で Destination がありません"
Else
pos1 = pos1 + Len(FindText4)
pos2 = InStr(pos1, strXML, """")
objIES.XML = Left(strXML, pos1 - 1) & Destination & Mid(strXML, pos2)
End If
End If
End Property

Private Sub Class_Terminate()
Set objIES = Nothing
End Sub

ってな感じ。

この回答へのお礼

回答ありがとうございます。
ファイルのパスやファイル名をどこに入れたらよいのでしょうか？
あと、100個くらいファイルがあるのですが、どのようにしたら良いでしょうか？

お礼日時：2020/01/30 21:25