• 締切済み

VBA　アプリケーション定義エラーについて

初めて質問させていただきます。 Excelファイルを読み込む処理をAcsess2000を使用して作成しております。 下記、プログラムを実行すると「↓エラー発生個所」箇所にて、 「アプリケーション定義またはオブジェクト定義エラー」が発生します。 Acsessについて、まだ知識不足なため困っております。 どなたか、原因または改善方法について教えていただけないでしょうか？ 宜しくお願い致します。 Public Function RoadExcelData(ByVal P_strSheetName As String, ByRef P_valDataArea As Variant) Dim objExl2 As Object Dim strSheetName As String Dim strReadStart As String Dim valDataArea As Variant On Error GoTo Err_Handle 'シート名称取得する strSheetName = m_rsCarrirData.Fields("SHEET_NAME_" & P_strSheetName) '読み込み開始位置を取得する strReadStart = m_rsCarrirData.Fields("READ_START_" & P_strSheetName) 　　'↓エラー発生個所 Set objExl2 = GetObject(m_rsCarrirData.Fields("FILENAME_PATH") & "\" & m_rsCarrirData.Fields("FILE_NAME_" & P_strSheetName)) objExl2.Worksheets(strSheetName).Activate 'Excelデータを読み込む With objExl2.Worksheets(strSheetName) P_valDataArea = .Range(strReadStart, .Range("A1").SpecialCells(11)).Value End With Exit Function Err_Handle: MsgBox Err.Description End Function

みんなの回答

  • yorozu_ya
  • ベストアンサー率54% (76/140)
回答No.1

GetObject の使い方を誤ってます。 ヘルプを読んで十分に理解しましょう。

  1. カテゴリ
  2. [技術者向] コンピューター
  3. プログラミング・開発
  4. Visual Basic

関連するQ&A

  • アプリケーション定義またはオブジェクト定義のエラー

    ＶＢＡを勉強し始めて１週間ほどになります。 そこで、掲題のエラーが出てしまい、何が原因か分からず途方にくれてます。 掲題のエラーで検索すると、同じようなエラーで悩んでいる人がいますが、 私の事例を解決する案を見つけることが出来ませんでしたので、 今回質問させていただきます。 まず、下記で示すプロシージャとは別のＳＵＢプロシージャで計算し、表を 作成します。表は、計算条件によって行数が変わります。 その表をクリアさせるのに、下記で示すSUBプロシージャを作成しました。 Public Sub 値のクリア() Dim a_clr As Integer 'Ａ列の縦の値 Dim b_clr As Integer 'Ｂ列の縦の値 Dim MaxRow As String '表の最終行を取得 Dim MaxCol As String '表の最終列を取得 MaxRow = Cells(Rows.Count, 4).End(xlUp).Row '表の行の最終行を取得 MaxCol = Cells(7, Columns.Count).End(xlToLeft).Column '表の列の最終列を取得 MsgBox (MaxRow) MsgBox (MaxCol) Worksheets("計算").Range("d7", Cells(MaxRow, MaxCol)).ClearContents ←　エラーになる。 Worksheets("計算").Range("d7", Cells(MaxRow, 16)).ClearContents 　　　←問題なく動作します。 End Sub これを動作させると、掲題のエラーが出ます。 エラーが出る箇所は、Rangeプロパティの行です。 プログラム中にも書いてますが、書き方により動作したり しなかったりします。 Range("d7", Cells(MaxRow, MaxCol)).ClearContents ←　エラーになります。 Range("d7", Cells(MaxRow, 16)).ClearContents　　　　←　問題なく動作します。 デバッグモードの時に、Cells(MaxRow, MaxCol))の中の変数（MaxRow, MaxCol）にマウス を持っていくと、数値が表示されます。 その数値は、私が必要としている数値がきちんと入っています。 それなのに、なぜここでとまっているのか分かりません。 また、Cells(MaxRow, MaxCol)をCells(MaxRow, 16)の用に数値にすると 問題なく動作する理由もよく分かりません。 変数の指定の仕方などが悪いのか、今一理解しきれていないのが原因かも 知れませんが、アドバイスをいただけると助かります。 よろしくお願いします。

  • EXCEL VBA のエラー処理

    EXCEL VBA でセルの文字列を読み(基本的に2007/05/08のような日付データが入っている)、 もしそれ以外のデータ("あいう"のような文字列)が入っていた場合はエラールーチンに飛ばして処理をしようと思ったのですが、 エラーが発生して、発生箇所が黄色く反転表示され、止まったままになってしまいます。 エラールーチンに飛ばすためにはどうしたらいいのでしょうか？ Sub test() Dim LineNo As Integer Dim WrkDate As Date On Error GoTo Err LineNo = 1 WrkDate = Range("S" & LineNo).Value　←ここが黄色く反転表示される。 WrkDate = WrkDate + 7 Range("X" & LineNo).Value = WrkDate GoTo Owari Err: (処理ルーチン) Owari: End Sub

  • 【VBA】入れ子のユーザー定義型

    閲覧ありがとうございます。 入れ子になってるユーザー定義型(構造体)に、値を代入する処理を抽象化したいのですが、上手くできません。 色々間違っているかもしれませんが、やりたいことのイメージは下のような感じです。 Private Type id kind As String memberId As String End Type Private Type items kind As String name As String id As id End Type sub main() (省略) Dim tmp As Variant tmp = jsonのレスポンスが1行ずつ配列で入ってる Dim items() As items items() = loading(tmp) (省略) End Sub Private Function loading(ByVal tmp As Variant) Dim pair() As Variant pair = Split(tmp, ":") Dim head As String Dim items() As items 　If 末尾が"{"だったら、 If pair(0) = "{" then head = "items(0)" else if pair(1) = "{" then head = head & pair(1) Else head.pair(0) = pair(1) ←pair(0)は名前、pair(1)は値がそれぞれ入っている endif loading = items() End Function 説明が下手すぎてすみません。 実際は、もっとたくさん入れ子になっている為、抽象化できないと非常に困ります。 答えられそうだけど質問の意味をもう少しきちんと…ということであれば努力しますので、なんとか、よろしくお願いいたします。

  • vbaでのerror"オーバーフロー"

    ・ ・ ・ dim x as variant x = (50 * 50 * 50) + (0.2 * 0.2 * 3.14 * 2000 * 2) + 10 ・ ・ ・ としたところ、x=…の箇所で 　error"オーバーフローしました"が生じます。 なぜエラーが生じるのかがわかりません。 また、解決策がありましたら教えていただけないでしょうか？ よろしくお願いいたします。

  • エクセルVBA　アクセスにインポート

    エクセルのデータ（列数、行タイトルは都度かわる）をアクセスにインポートしテーブルを作成したいと思っています。 VBAでこの処理をおこないたく、下記のコードで実行したのですがデバッグがはしってしまいます。 （DとEでデバッグ） 原因がお分かりになる方がおりましたら、教えていただけますでしょうか？ 何卒、よろしくお願い申し上げます。 Function ExcelDataImport() 'On Error GoTo エラー Dim varac As Variant Dim varxls As Variant Dim strrange As String Dim strmsg As String varac = "T_TESTTABLE" ' --- A varxls = "C:\Users\AC\Desktop\ACTEST\RAWDATA.xlsx" ' ---Ｂ strrange = "TEST_RAWDATA" ' --- C strmsg = "Excelファイル" & varxls & " を、Accessテーブル " & varac & _ "へ、データ入力を行います。" & Chr(13) & _ "Excelファイルの入力レンジは、 " & strrange & " です。" DoCmd.DeleteObject acTable, varac ' --- D If MsgBox(strmsg, vbOKCancel) = vbOK Then DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, _ varac, varxls, True, strrange ' -- E MsgBox "データ入力は、正常に完了しました。" End If Exit Function エラー: MsgBox "予期せぬエラーが発生しました。" & Chr(13) & _ "エラー番号：" & Err.Number & Chr(13) & _ "エラー内容：" & Err.Description, vbCritical Exit Function End Function

  • VBA　アプリケーション定義またはオブジェクト定義のエラーです

    VBA初心者です。 仕事中、暇な時にVBAの勉強をしています。 あるファイルのフォーマットを指定されたフォーマットに変換するプログラムを作成しています。 実行後、「アプリケーション定義またはオブジェクト定義のエラーです」と出て、先に進めません。 どなたが分かる方、ご教授お願い致します。 以下ソース Private Sub CommandButton1_Click() ' 変数定義 Dim openFileName As String Dim priorYearBudget As String, thisYearBudget As String, increaseAnddecrease As String Dim bigSection As String, mediumSection As String, smallSection As String Dim fileLastRow As Long, buf As Long, index As Long Dim head As String ' 初期化 index = 2 ' ファイル名取得 openFileName = Application.GetOpenFilename("Microsoft Excelブック,*.xls") If openFileName <> "False" Then ' ファイルが存在したらファイルを開く Workbooks.Open openFileName ' 項目を変数に格納 ' bigSection = Sheets(1).Cells(1, 3) ' mediumSection = Sheets(1).Cells(1, 4) ' smallSection = Sheets(1).Cells(1, 5) priorYearBudget = Sheets(1).Cells(1, 6) thisYearBudget = Sheets(1).Cells(1, 7) increaseAnddecrease = Sheets(1).Cells(1, 8) ' ファイルの最終行を取得(データが格納されている行) fileLastRow = ActiveSheet.Cells.SpecialCells(xlLastCell).Row ' ワークシートの追加 Worksheets.Add after:=Worksheets("Sheet1") ' セルの幅指定 Columns("A").Select Selection.ColumnWidth = 70 Columns("B:D").Select Selection.ColumnWidth = 13 Columns("A").Select ' 幅設定で選択されたセルを解除 range("A1").Select ' 新規に追加されたワークシートに項目を設定 Sheets(2).Cells(1, 1).Value = "勘定科目" Sheets(2).Cells(1, 2).Value = priorYearBudget Sheets(2).Cells(1, 3).Value = thisYearBudget Sheets(2).Cells(1, 4).Value = increaseAnddecrease ' 元ファイルの見出しの形式を変更 For headCnt = 1 To fileLastRow head = Sheets(1).Cells(headCnt, 1) bigSection = Sheets(1).Cells(index, 3) midiumSection = Sheets(1).Cells(index, 4) smallSection = Sheets(1).Cells(index, 5) If head <> "" Then ' 項目設定 Sheets(2).Cells(headCnt, 1).Value = "【" & head & "】" End If If bigSection <> "" Then ' 大区分設定 Sheets(2).Cells(buf, 1).Value = bigSection←ここでエラー発生 ElseIf midiumSection <> "" Then ' 中区分設定 Sheets(2).Cells(buf, 1).Value = midiumSection ElseIf smallSection <> "" Then ' 小区分設定 Sheets(2).Cells(buf, 1).Value = smaillsection End If ' Sheets(2).Cells(cnt, 1).Value = head ' head = Sheets(1).Cells(cnt, 1) index = index + 1 buf = buf + 1 Next headCnt ' 元ファイルの金額をそのままコピー For budgetCnt = 2 To fileLastRow Sheets(2).Cells(budgetCnt, 2).Value = Sheets(1).Cells(budgetCnt, 6) Sheets(2).Cells(budgetCnt, 3).Value = Sheets(1).Cells(budgetCnt, 7) Sheets(2).Cells(budgetCnt, 4).Value = Sheets(1).Cells(budgetCnt, 8) Next budgetCnt Else MsgBox "キャンセルされました" Exit Sub End If End Sub 補足 エラーが発生する箇所をコメントアウトすると、正常に動作します。 よろしくお願い致します。

  • EXCEL2000とEXCEL2003のVBAについて

    現在、EXCEL2000で下記のコードを実行しています。 が、EXCEL2003で実行すると、 .UsedRange.Copy myb のコードが実行されているのにコピー出来ていません。 ファイルは開いていて、エラーは出ていないのです。 問題点わかる方教えていただけますか？ Sub 日別データ読込() Dim rngsaki As Range Dim pathmacrobook As String Dim namebook As String Dim motobook As Workbook Dim myb As Variant Set rngsaki = Workbooks("残高集計用.xls").Worksheets(3).Range("a2") pathmacrobook = ThisWorkbook.Path & "\CSV読込データ12\" namebook = Dir(pathmacrobook & "*.xls") Do While Not namebook = "" Set motobook = Workbooks.Open(pathmacrobook & namebook) Set myb = Workbooks("残高集計用.xls").Worksheets(3).Range("A65536").End(xlUp) With motobook.Worksheets("Sheet1") .UsedRange.Copy myb End With motobook.Close False namebook = Dir() Loop MsgBox "完了しました" End Sub

  • Excel　VBA配列をFunctionに渡す

    こんばんは、引数について教えてください。 Excel　VBAの関数を作っていましたが、 1.Function ColumnArrayの部分でコンパイルエラーが発生し、 　「配列がありません」と表示されます。 　引数を配列のみで渡した場合、問題なく渡せるようですが、 　他の引数と、CriteriaArrsの配列と一緒に渡せないのでしょうか。 　すべて配列として１つにまとめて渡さなければならないのでしょうか。 2.CriteriaArrs = Array("田中", "鈴木")の部分は、文字列の増減が発生しますので 　配列はParamArray 　CriteriaArrs()とした方がよいのでしょうか 説明が不足している点があるかもしれませんが宜しくお願いいたします。 Function ColumnArray(SheetName As Worksheet, _ StartCell As Range, _ FieldColumn As Long, _ CountColumn As Long, _ CriteriaArrs As Variant _ ) As Long ・・・ End Function ------------------------------------- sub test() Dim CriteriaArrs() As Variant Dim SheetA As WorkSheet DIm RangeA range CriteriaArrs = Array("田中", "鈴木") set SheetA =Worksheet(1) set RangeA=Range("B3") FilterCount = ColumnArray(SheetA, RangeA, 3, 2, CriteriaArrs) end sub

  • マクロを変数を使って実行する場合のVBAの書き方について教えてください。

    抽出条件によりデータベースから読込んだマクロが SYORI_001の場合 Dim Macro_Name As String Dim val As Variant Macro_Name = Rst.Fields("Macro_Name").Value Macro_Name = "Call " & Macro_Name val = Macro_Name これだとコンパイル　エラー： Sub、 Function、またはPropertyが必要です。となってしまいます。 echo文のように単純に、echo "Call SYORI_001"　としたいのですが VBAで書くにはどうしたら良いのでしょうか？ どうぞよろしくお願いします。

  • VBAでVLOOKUP関数を使う

    下記VBAでResultsを反映する（更新）するのは、 空白セルだけにするのは、どうすれば良いのでしょうか。 （※参考：http://myrtus21.com/blog/2007/06/vbavlookup.html） 1日かけてトライしていますが、打開できません。 どなたかご教授願います。 どうかよろしくお願いいたします。 Sub 在庫数検索() Dim SerchName As String Dim SerchArea As Range Dim Results As Variant '初期設定 Range("A2").Activate ItemCode = Range("A2").Value i = 0 '検索範囲の設定（ポイント1） Set SerchArea =Worksheets("シート2").Range("List1") '商品コードが空になったら終わり Do Until ItemCode = "" 'エラーになっても続行する（ポイント2-1） On Error Resume Next '商品コードに該当するデータを探し、Resultsに入れる ItemCode = ActiveCell.Offset(i, 0).Value Results =Application.WorksheetFunction.VLookup(ItemCode, SerchArea, 2, False) '該当するデータがないとエラーになるための処理、エラーなら空欄にする（ポイント2-2） If Err <> 0 Then Results = "" ActiveCell.Offset(i, 1) = Results i = i + 1 Loop End Sub

注目のQ&A

カテゴリ

専門家に質問してみよう

職業から探して質問する

あなたにピッタリな商品が見つかる！ OKWAVEセレクト

質問する