こんにちはゲストさん。会員登録(無料)して質問・回答してみよう!

解決済みの質問

アクセス2003・VBA

アクセス2003を使っています。
アクセスのVBAを使って下記のやり方を教えて下さい。

(1)ファイル名を指定して、エクセルファイルを開く。
(VBA構文上でファイル名を入力し、固定するのではなく、そのVBAを実行すると、ファイルをダイアログで選択する方法です。)

(2)その開いたファイルで2行目からデータが入っている行までをコピーし、そのVBAを実行しているアクセスファイルの特定のテーブルに貼り付ける。

上記の方法がお分かりの方、是非教えて下さい。
よろしくお願いします。

投稿日時 - 2008-04-26 22:40:11

QNo.3978444

すぐに回答ほしいです

質問者が選んだベストアンサー

ANo.6で書き落としていましたが、アクセスからエクセルを操作するには、参照設定でMocrosoft Excel 11.0 Object Libraryも参照する必要があります。
また、エクセルからテーブルをインポートする際、同名のテーブルが存在するとエラーになります。このような場合、On Error Goto文を記載し、エラーとして、Err.Number=3012の場合、Docmd.DeleteObject acTable, "ExcelTemp" を実行し、インポート文の前にResumeさせます。これで、既存テーブルがある場合でも、問題なく実行できます。

投稿日時 - 2008-04-28 23:15:55

ANo.7

このQ&Aは役に立ちましたか?

0人が「このQ&Aが役に立った」と投票しています

回答(7)

ANo.6

(2)について検討してみました。
インポートする範囲は、その都度変化すると考えられます。従って、毎回、データの入力されている最後尾の行列位置を検出する必要があります。この点を考慮してコードを作成してみました。ANo.2の続きです。
Dim MyRow As Variant, MyColumn As Variant, SheetName As String

Set XLAPP = CreateObject("Excel.Application")
Set XLWB = XLAPP.Workbooks.Open(strFileName)
Set XLWS = XLWB.Worksheets(1)

With XLAPP
MyRow = .ActiveCell.SpecialCells(xlLastCell).Row '最後尾セルの行数取得
MyColumn = .ActiveCell.SpecialCells(xlLastCell).Column '最後尾セルの列数取得
End With
SheetName = XLWS.Name 'シート名の取得
ActiveWorkbook.Names.Add Name:="MyData", RefersToR1C1:= _
"=" & SheetName & "!R2C1:R" & MyRow & "C" & MyColumn 'データ範囲にMyDataという名前を付ける。
XLWB.Save 'エクセルブックを保存する。
XLAPP.Quit 'エクセルを終了する。

Set XLAPP = Nothing
Set XLWB = Nothing
Set XLWS = Nothing

DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel8, "ExcelTemp", strFileName, False, "MyData" '名前がMyDataの範囲をテーブルExcelTempにインポートする。

次に、インポートされたExcelTempテーブルのフィールド1、フィールド2・・・を目的のテーブルへ追加する追加クエリーを実行します。夫々のフィールドが目的のテーブルのフィールドに一致するよう作成します。
この時、ダブってインポートしてしまうケースを防止する対策を取っておく方が安全です。事前に、すべてのフィールが一致するデータが登録されていないか確認するクエリーを作成し、確認する必要があります。一致するデータがある場合、警告を表示させるようにするといいと思います。

投稿日時 - 2008-04-27 17:41:01

ANo.5

No.3 です。

 No.4 さんの書かれたとおり、Docmd.TransferSpreadsheet ...を使うとよろしいと思います。
Visual Basic のヘルプに載っておりますので(VBエディタのヘルプから参照できます?よね)、
詳しくはそれを見ていただくとしまして、TransferSpreadsheet メソッドの引数に“hasfieldnames”
というのがあります。その値をTrueにすれば、開いたワークシートの1行目はテーブルのフィールド名
として扱うようになりますので、2行目以降がデータとして認識されます。

例) Docmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel8, "T_商品", _
      "C:\Data\Shouhin.xls", True, "Sheet2!A1:G5"

 最後の引数部分がワークシートの範囲を指定するところですが、範囲指定省略もできます。
自分のマシン(Access & Execl 2000)では省略すると、第1番目のワークシート全てを取り込む
ことが出来ました。
 私の場合、最後の引数を "Sheet3" として実行するとエラーがでましたが、名前の最後に
イクスクラメーション(!)を付けると("Sheet3!")、正しくそのワークシート名の全てのデータ
を取得しました。

投稿日時 - 2008-04-27 14:32:18

ANo.4

(2)ですが、エクセルの一行目は、どのようなデータが入っているのでしょうか?
貼り付けたいテーブルのフィールド名と一致しているのであれば、指定したエクセルファイル名でインポートし、そのテーブルを使用して追加クエリーを作成すればよいと思います。
フィールド名に相当するデータが入っていないのであれば、エクセルでコピーしたい範囲に名前を付けて、この範囲名を指定してインポートして、追加クエリーを実行する事になります。
インポートは、DoCmd オブジェクトの TransferSpreadsheet メソッドで行います。

投稿日時 - 2008-04-27 07:47:17

お礼

回答ありがとうございます。
エクセルの1行目は項目が入っております。
しかし、貼り付けたいテーブルのフィールド名とは一致しておりません。(特に項目名についてはこだわりがないので、エクセルの項目名とテーブルのフィールド名を一致させることはできます。)

大変恐縮ですが、「インポートは、DoCmd オブジェクトのTransferSpreadsheet メソッドで行う方法」を具体的に教えて頂けないでしょうか?
勤務先でしかアクセスができないので、No2で回答して頂いたやり方はまだ実践していません。明日やってみます。

よろしくお願いします。

投稿日時 - 2008-04-27 12:50:39

ANo.3

こんばんは。
以下のホームページが参考になるかと思います。
私も勉強&はげみになっております。

「Microsoft Access Club」
http://www.accessclub.jp/samplefile/samplefile_127.htm
http://www.accessclub.jp/samplefile/samplefile_159.htm

投稿日時 - 2008-04-27 01:03:02

お礼

回答ありがとうございます。
早速参考リンク先を拝見しました。
勤務先でしか、アクセスができないので、まだ実践しておりませんが、明日やってみたいと思います。

回答者様に教えて頂いた方法で「2行目からデータが入っている行までコピー」という方法はできるのでしょうか?

大変恐縮ですが、よろしくお願いします。

投稿日時 - 2008-04-27 12:43:21

ANo.2

(1)ファイル名を指定して、エクセルファイルを開く。
vb Editor 参照設定でMicrosoft Office 12.0 Object library にチェックを入れます。
新規モジュールを作成し、
Option Compare Database
Option Explicit
Public Function ExecFileDialog(intMode As Integer) As Variant
Dim fd As FileDialog
Dim varSelItems As Variant
Set fd = Application.FileDialog(intMode)
fd.AllowMultiSelect = False
If fd.Show = -1 Then
For Each varSelItems In fd.SelectedItems
ExecFileDialog = varSelItems
Next
Else
ExecFileDialog = Null
End If
Set fd = Nothing
End Function

と入力します。
適当なフォームにコマンドボタンを作り、

Dim strFileName as Variant
Dim XLAPP As Excel.Application
Dim XLWB As Excel.Workbook
Dim XLWS As Excel.Worksheet
strFileName = ExecFileDialog(msoFileDialogFilePicker)
If IsNull(strFileName) then
MsgBox "ファイルが指定されていません!"
Exit Sub
End If
Set XLAPP = CreateObject("Excel.Application")
Set XLWB = XLAPP.Workbooks.Open(strFileName)
Set XLWS = XLWB.Worksheets(1)
XLAPP.Visible = True
XLWS.Select
XLWS.Visible = True
のようにクリック時イベントプロシージャを作成します。
これで、ファイルダイアログでファイル指定し、エクセルでそのファイルを開き、画面に表示されるはずです。(2)まで完全に自動で行うなら、エクセルを表示する必要はありませんが。
(2)は、後ほど回答できると思います。

投稿日時 - 2008-04-27 00:09:17

お礼

ご丁寧な回答ありがとうございます。
非常に参考になります。

投稿日時 - 2008-04-27 12:51:10

ANo.1

貼り付けでなくインポートですね。

エクセルからインポートするなら、
TransferSpreadsheetアクションを使います。
あとはググった方が....

投稿日時 - 2008-04-26 23:11:26

お礼

回答ありがとうございます。
TransferSpreadsheetを調べてみますね。

投稿日時 - 2008-04-27 12:35:44

あなたにオススメの質問