• ベストアンサー

Access2000にExcel2000のデータを読み込みたい。

Access上のVBAでExcelよりデータを読み込もうと思います。 最終行を求めるに xlUp を使用しようと思いましたが、 #実行時エラー '1004' #Rangeクラスの Select メソッドが失敗しました。 となります。 どこをがおかしいでしょうか?   Dim wb As Excel.Workbook   Dim ws As Excel.Worksheet   Set wb = GetObject(C:\abc.xls")  '---オープン確認   Set ws = wb.Worksheets("Sheet1")   ws.Range("A65536").Select   '----実行時エラー   ws.Selection.End(xlUp).Select         また、abc.xlsにマクロが含まれているためにマクロを有効にするかどうかの確認メッセージがでます。これを有効、無効どちらでもいいですが、メッセージ無しに開くにはどうすればいいでしょうか?

noname#27115
noname#27115

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

  • ベストアンサー
  • mach999
  • ベストアンサー率75% (36/48)
回答No.2

 Selectメソッドは選択しようとしているセルを含むワークシートがアクティブではないと失敗するため、ほかのメソッドの実行に成功するような場合でもSelectメソッドはエラーになる可能性があります。実際、GetObject関数ではワークブックを非表示状態で開いているため、Selectメソッドが失敗しているのです。このため、Selectメソッドを実行する前に wb.Application.Windows("abc.xls").Visible = True としてワークブックを再表示しておく必要があります。 >メッセージ無しに開くにはどうすればいいでしょうか?  確認メッセージはGetObject関数を実行すると直ちに表示されるので、ActiveXオブジェクトを開いた後に確認メッセージを抑止するための処理を記述する余地はありません。また、GetObject関数はActiveXオブジェクトを開くための汎用的な関数であり、個別のActiveXオブジェクト用のオプションをつけることはできないため、ActiveXオブジェクトを開くときに確認メッセージを抑止する手段もありません。ですから、GetObject関数を使う限りは確認メッセージ無しにExcelワークブックを開くことは不可能だと思います。  というわけで、素直にDoCmd.TransferSpreadsheetメソッドでテーブルにデータを読み込むのが無難です。   DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, "テーブル名", "C:\abc.xls", False (末尾のBooleanは、先頭をフィールド名として読み込むのであればTrueにして下さい)

その他の回答 (3)

  • imogasi
  • ベストアンサー率27% (4737/17068)
回答No.4

#3です。 似た目的の d = ws.Range("A1").currentregion.rows.Count MsgBox d は旨く行きました。 #3も本件も、ACCESSのモジュールから実行してます。 定数XlUpがエクセル定数(xl)が何か関係あるのかな。 いまやって見ると d = ws.range("a65536").end(-4162).row MsgBox d で旨く行くようです。 これが原因かも。 -4162はエクセルVBE画面で Sub test01() MsgBox xlUp End Sub を実行して判りました。

noname#27115
質問者

お礼

ご回答ありがとうございました。 最終的には DoCmd.TransferSpreadsheet が一番楽そうなのでこれで 行こうと思います。 また、最終行の取得には d = ws.range("a65536").end(-4162).row が動きましたので、これを使わせてもらいたいと思います。 どうもありがとうございました。

  • imogasi
  • ベストアンサー率27% (4737/17068)
回答No.3

判らないのに投稿して済みません。 Sub test0a() Dim ex As Object Set ex = CreateObject("excel.application") ex.Application.Visible = True ex.Workbooks.Open FileName:="c:\My Documents\aaa14.xls" Set ws = ex.Worksheets("Sheet1") ws.Activate 'MsgBox ws.Range("A65536") ws.Range("A65536").select '.End(xlUp).Row MsgBox ws.Range("a1") ex.Workbooks.Close ex.Quit Set ex = Nothing End Sub では旨く行きます。 だのに MsgBox ws.Range("A65536").End(xlUp).Row や MsgBox ws.Range("A65536").End(xlUp).select ではエラーに成ります。 Set rg = ws.range("A65536") d = rg.Row MsgBox d などは旨く行きます。 End(xlUp)に原因がないか調べ中です。私の力では判りそうもありませんが。

  • snoopy64
  • ベストアンサー率42% (337/793)
回答No.1

エラーになる原因はちょっとわかりませんが・・・ そのエラーの直前で MsgBox ws.Range("A65536").End(xlUp).Value とやると、最終セルの値がちゃんと表示されますね。 このことから想像するに、GetObjectはあくまでもオブジェクトを取得するだけで、ブックをオープンしているわけではないので、Selectのような「メソッド」(表示系)は使えないのかな~と。 Valueのような「プロパティ」(値系)なら使えるのでしょうかね・・・ あくまでも感覚的なものですが。

関連するQ&A

  • EXCELのセルの値を表示する

    VB6.0を使っています。 エクセルのC5のセルに50という値が入っています。 この値をVBのメッセージボックスで見たいのですが 実行して見てみると 「50」ではなく何故か「0」と表示されてしまいます。 どうしてでしょうか? その部分のコードは下です。 Dim Wb As Excel.Workbook Dim Ws As Excel.Worksheet Dim Ea As Excel.Application Dim atai As Integer Set Wb = GetObject("C:\test\test.xls") Set Ea = Wb.Application Set Ws = Wb.Worksheets("Sheet1") atai = Ws.Cells(3, 5) MsgBox (atai)

  • 最終セルまでデータを反映させるマクロ

    あるサイトからの利用コードです。 それをアレンジしようとしましたが、つまずきました。 マクロコードをご教示ください。 あるフォルダに複数のエクセルファイルがあります。 構成が同じシート(名前は同じ。仮に "各シート")を、 別ブック(仮に "まとめ")の一つのシートに纏めます。 その時、複数ファイルの D4のデータだけは "まとめ"ブックのL列に反映させたいのですが、 下記コードを使用すると、どこにどのようなコードを入れたら良いのでしょうか? 因みに複数ファイルの8行目からコピーされ、 複数ファイルのCからM列は まとめブックのAからK列に反映されるようになってます。 (まとめブックの1行目は見出し) Dim i As Integer Dim strPath As String Dim strFileName As String Dim WB1 As Workbook Dim WS1 As Worksheet Dim WS2 As Worksheet Dim lngRowCount As Long Set WS2 = Sheets("まとめ") strPath = ThisWorkbook.Path strFileName = Dir(strPath & "\*.xls*") Do While strFileName <> "" If strFileName <> ThisWorkbook.Name Then Set WB1 = Workbooks.Open(strPath & "\" & strFileName) Set WS1 = WB1.Sheets("各シート") With WS1.Range("C7") lngRowCount = .Worksheet.Cells(.Worksheet.Rows.Count, .Column).End(xlUp).Row - .Row If lngRowCount >= 1 Then With .Resize(lngRowCount, 11).Offset(1) .Copy WS2.Range("A" & WS2.Rows.Count).End(xlUp).Offset(1) End With End If End With _____ここで つまずく_____    With WS1.Range("D4")     .Copy WS2.Range("L" & WS2.Rows.Count).End(xlUp).Offset(1)     WS2.Range("L" & WS2.Rows.Count).End(xlUp).AutoFill Destination = Range("E1048576").End(xlUp).Row _____ここまで つまずく_____ WB1.Close False End If strFileName = Dir Loop End Sub エクセル2013です。 宜しくお願い致します。

  • EXCEL2010エラーVBA

    下記を実行するとエラーになりEXCEL2010が終了してしまいます。 fDebug:0 offset00009391 がエラーメッセージです。 何が原因でしょうか。 Private Sub Worksheet_Change(ByVal Target As Range) Dim ws As Worksheet Dim rg As Range Dim r As Variant Dim c As Long Dim hanni1 As Range Dim atai As Range Set ws = Worksheets("あああ") Set rg = Worksheets("コード").Range("A1:B10") r = ws.Cells(Rows.Count, 1).End(xlUp).Row Set hanni1 = ws.Range(Cells(2, 2), Cells(r, 3)) Set atai = ws.Range(Cells(2, 3), Cells(r, 3)) atai = Application.VLookup(hanni1, rg, 2, False) End Sub

  • VBA 実行時エラーで、"プロパティまたはメソッド

    ・Sheet1(コード) Private Sub CommandButton1_Click() Call aaa End Sub ・Module1(コード) Sub aaa() Dim wb As Workbook Dim ws As Worksheet Workbooks.Open ("c:\test.xls") Set wb = Workbooks("test.xls") Set ws = wb.Worksheets("Sheet1") wb.ws.Range("A2").Value = "CCC" End Sub wb.ws.Range("A2").Value = "CCC"の部分で 以下の実行エラーが出ます。 ------------------------------------------------------------------------ 実行時エラー'438': オブジェクトは、このプロパティまたはメソッドをサポートしていません。 ------------------------------------------------------------------------ Set wb = Workbooks("test.xls") Set ws = wb.Worksheets("Sheet1") の部分で特にエラーも出ないので、オブジェクトの取得は成功していると 思うのですが、WorkSheetオブジェクトのwsからRangeメソッドを呼ぶことが できません。 動かない原因と対策を教えてください!!

  • VBAエクセルにて開いてないエクセルシートを開いてるシートに所得

    お世話になります。 「同じフォルダー内にBOOKが2つ有ります。1つ(AK.xls)を立上げて もう1つの(EX.xls)を立上げずに、EX.xls内のSheet1をコピーして AK.xlsのシート(STEP1)に貼り付けようとしています。」 どうしてもエラーが出てしまいます。 何方か、分かる方教えて下さい。 また記述して戴ければもっと助かります。 エラーは”1004”EX.xlsが見つかりません。と出てしまいます。 Sub ST() Dim wsSrc As Worksheet, WS As Worksheet Dim PasteR As Range Dim x As Long Sheets("STEP1").Select Cells.Select Selection.Delete Shift:=xlUp Range("A1").Select   Set wsSrc = ActiveSheet Workbooks.Open "EX.xls" For Each WS In Worksheets x = WS.Range("A1").CurrentRegion.Rows.Count If WS.Index = 1 Then Set PasteR = wsSrc.Range("A1") Else Set PasteR = wsSrc.Range("A65536").End(xlUp).Offset(1) End If WS.Range(WS.Cells(1, 1), WS.Cells(x, 44)).Copy PasteR Set PasteR = Nothing Next ActiveWorkbook.Close False Set wsSrc = Nothing End Sub デバックでは Workbooks.Open "EX.xls"この部分が黄色になります。 是非、回答を宜しくお願い致します。

  • 複数のエクセルシートをまとめるマクロ

    下は複数のエクセルファイルを一つにするマクロですが、100万件を超えるためcsvで保存するようにするにはどこを変更したらよいでしょうか。 よろしくお願いします。 Sub Sample() Dim t As Single Dim strPath As String Dim strFileName As String Dim WB1 As Workbook Dim WS1 As Worksheet Dim WS2 As Worksheet Dim lngRowCount As Long 'A列に値が入っているデータ数 t = Timer 'まとめたいシート Set WS2 = ThisWorkbook.Worksheets(1) strPath = ThisWorkbook.Path strFileName = Dir(strPath & "\*.xls*") Do While strFileName <> "" If strFileName <> ThisWorkbook.Name Then Set WB1 = Workbooks.Open(strPath & "\" & strFileName) Set WS1 = WB1.Worksheets(1) With WS1.Range("A1") lngRowCount = .Worksheet.Cells(.Worksheet.Rows.Count, .Column).End(xlUp).Row - .Row If lngRowCount >= 1 Then With .Resize(lngRowCount, 14).Offset(1) .Copy WS2.Range("A" & WS2.Rows.Count).End(xlUp).Offset(1) End With End If End With WB1.Close False End If strFileName = Dir Loop MsgBox "まとめ処理をしました。処理時間 " & Format((Timer - t) / 60 / 60 / 24, "h:mm:ss") End Sub

  • VBAがとまります。

    フォルダ内の全てのエクセルデータを一つにまとめたいのですが、 下記を実行すると、『実行時エラー1004 アプリケーション定義またはオブジェクト定義のエラーです。』のメッセージが出て先に進みません。対象のデータを開いて実行しても同様でした。 調べましたがよくわかりませんので、ご教示いただけませんでしょうか。 基本的なところかもしれませんが、よくわかりません。 どうぞよろしくお願いいたします。 ------------------------------------------------------- 'プログラム1|プログラム開始 Sub GetExcelDataInFolder() 'プログラム2|シート設定 Dim ws1 As Worksheet Set ws1 = ThisWorkbook.Worksheets("Sheet1") 'プログラム3|FileSystemObjectの設定 Dim fs As FileSystemObject Set fs = New FileSystemObject 'プログラム4|対象フォルダを取得 Dim myfolder As Folder Set myfolder = fs.GetFolder(ThisWorkbook.Path) 'プログラム5|対象フォルダ内の全ファイルを処理 Dim myfile As File For Each myfile In myfolder.Files 'プログラム6|拡張子が「xlsx」のファイルのみを処理 If fs.GetExtensionName(myfile) = "xlsx" Then 'プログラム7|フォルダ内のエクセルを開いてシートを設定 Dim wb As Workbook Set wb = Workbooks.Open(Filename:=myfile) Dim ws2 As Worksheet Set ws2 = wb.Worksheets(1) 'プログラム8|開いたエクセルの最終行を取得 Dim cmax As Long cmax = ws2.Range("A65536").End(xlUp).Row Debug.Print myfile.Name & "のcmax=" & cmax 'プログラム9|開いたエクセルのデータを転記 Dim i As Long For i = 2 To cmax Dim cmax1 As Long cmax1 = ws1.Range("A65536").End(xlUp).Row ws1.Range("A" & cmax1 + 1 & ":E" & cmax1 + 1).Value = ws2.Range("A" & i & ":E" & i).Value Next 'プログラム10|エクセルを閉じる wb.Close 'プログラム11|オブジェクト解放 Set ws2 = Nothing Set wb = Nothing End If Next 'プログラム12|エクセルを保存 ThisWorkbook.Save 'プログラム13|オブジェクト解放 Set myfolder = Nothing Set fs = Nothing 'プログラム14|プログラム終了

  • ワードのマクロからエクセルシートを開きデータを読み込む

    ワードマクロからエクセルシートのデータを読み込みたいのですが、マクロを実行すると「コンパイルエラー:変数が定義されていません。」というエラーが出てしまいます。変数xlUpで引っかかってるようなんですが、どのように定義すればよいですか? コードは以下です。 Dim Workbooks As Object Dim ecell As Integer Workbooks.Open FileName:="namesheet.xls" ecell = Workbooks("namesheet.xls").Worksheets(1).Range("B100").End(xlUp).Row よろしくお願いいたします。

  • EXCELマクロ シートのありなし

    EXCELのマクロでシートの存在を返す関数を作っています。 一応動くのですが、ブックをいちいちアクティブにしているのが 気に入りません。スマートな手法を教えて頂けませんか。 よろしくお願いします。 例)  A.xls、B.xls、C.xls、D.xlsのように複数のブックが開かれています。  マクロは、マクロ.xlsというファイルに記述しているとします。  例えば、A.xlsというファイルにsheet4という名前のシートが存在するか調べたい。 Function isExistingSheetName2(Bookname As String, sheetname As String) As Boolean Dim wb As Workbook Dim ws As Worksheet Dim flag As Boolean Dim wbown As Workbook Dim wsown As Worksheet '現在を記憶 Set wbown = ThisWorkbook Set wsown = ActiveSheet '判定 Set wb = Workbooks(Bookname) wb.Activate                  ’←特に気に食わない   For Each ws In Worksheets If ws.Name = sheetname Then flag = True Next ws '元に戻る wbown.Activate                ’←気に食わない    wsown.Select                 ’←若干気に食わない   '戻り値 If flag = True Then isExistingSheetName2 = True Else isExistingSheetName2 = False End If End Function ’excel 2002 SP3 ’windowsXP Pro SP3

  • エクセルのマクロを使ってデータ範囲が毎回異なるグラフを書きたいです

    あるシステムからデータをエクセルに落とすため、毎回、行や列の数が変わります。 テキスト本を見て下のようなマクロを作成しましたが、うまくいきません。どなたか教えていただけないでしょうか。 Sub グラフシート作成() Dim WS As Worksheet Dim Crt As Chart Range("A65536").End(xlUp).End(xlToRight).Activate Range("A1:" & Selection.Address).Select Set WS = Worksheets("Sheet1") Set Crt = Charts.Add With Crt .ChartType = xl3DBarStacked .SetSourceData Source:=WS.Range(ここに何を書けばいいのでしょうか?), PlotBy:=xlColumns .Name = "野菜栄養価表" End With Set WS = Nothing Set Crt = Nothing End Sub

専門家に質問してみよう