Access (VBA)

Access VBAに関するフォーラムです。
  • 解決済みのトピックにはコメントできません。
このトピックは解決済みです。
質問

 
(Windows 7 Professional : Access 2013)
実行時エラーの解決
投稿日時: 17/04/29 17:56:18
投稿者: dum0785

下記VBAは一部分ですが、アクセスで処理したデータをエクセルで掃き出し、エクセルのA列のデータが入っている最終行までD列のデータをデコード処理するということを考えています。
しかし、下記VBAのFor文の手前で「オブジェクトが必要です。」と出てしまいます。
このエラーの解決方法をご教示お願い致します。
 
-------------------------------------------------------------------------------------
Dim xlObj As Object
 Dim wbObj As Object
 Dim wsObj As Object
 Dim i As Integer, n As Integer
 
 
 
 
     Dim FileName As String
 
 
     デスクトップ = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\"
 
     FileName = デスクトップ & Format(Now(), "yyyymmdd") & "_宛先メールアドレス一覧" & ".xlsx"
 
 
 Set xlObj = CreateObject("Excel.Application")
 n = xlObj.SheetsInNewWorkbook
 xlObj.SheetsInNewWorkbook = 1
 Set wbObj = xlObj.WorkBooks.Add
 xlObj.SheetsInNewWorkbook = n
 wbObj.SaveAs FileName
 wbObj.Close
 
 
 
     DoCmd.TransferSpreadsheet acExport, _
             acSpreadsheetTypeExcel12Xml, "Q_Alert_Details", _
             FileName, True, "宛先一覧"
 
Set wbObj = xlObj.WorkBooks.Open(FileName)
  i = 1
 Set wsObj = wbObj.WorkSheets(i + 1)
 
 wsObj.Name = "宛先" & i
 Set wsObj = wbObj.WorkSheets(2)
 wsObj.Name = "宛先一覧"
wbObj.WorkSheets(1).Delete
   wbObj.WorkSheets(1).Columns(1).ColumnWidth = 20
   wbObj.WorkSheets(1).Columns(2).ColumnWidth = 32
   wbObj.WorkSheets(1).Columns(3).ColumnWidth = 56
   wbObj.WorkSheets(1).Columns(4).ColumnWidth = 43
   wbObj.WorkSheets(1).Columns(5).ColumnWidth = 37
   wbObj.WorkSheets(1).Range("A1").Interior.Color = 16764057
   wbObj.WorkSheets(1).Range("B1").Interior.Color = 16764057
  wbObj.WorkSheets(1).Range("C1").Interior.Color = 16764057
 wbObj.WorkSheets(1).Range("D1").Interior.Color = 16764057
 wbObj.WorkSheets(1).Range("E1").Interior.Color = 16764057
 
    Dim m As Long
  Dim LastRow As Long
'=========================================================================
’ココでエラーが出ます。
 
    LastRow = wbObj.WorkSheets(1).Cells(Rows.Count, 1).End(xlUp).Row
 
'=========================================================================

 
  For m = 1 To LastRow
 
 
If wbObj.WorkSheets(1).Cells(m, 4).Value Like "*" Then
   ' 表示
 
  ' オブジェクト変数 CDO ← CDO.Message(送信メール)型オブジェクトを作成したもの
  Set CDO = CreateObject("CDO.Message")
   ' オブジェクト変数 ADO ← CDO.Message型を ADOストリーム型に変換したもの
  Set ADO = CDO.GetStream
   ' ADO.WriteText メソッドにより、メールの件名として文字列を入れる
  ADO.WriteText "Subject: " & wbObj.WorkSheets(1).Cells(m, 4)
   ' ADO.SetEOS メソッドにより、ストリームの内容を現在位置で終了(書込終了)
   ADO.SetEOS
   ' ADO.Flush メソッドにより、CDO.Message 型オブジェクト(つまりは元オブジェクト)へ変更内容を書き戻す
  ADO.Flush
   ' CDO の件名を表示してみると、結果的に変換されている
 
  ' 普通の文字列型変数に値を取得しなおしてみる
  Dim SJIS_STRING As String
   SJIS_STRING = CDO.subject
   ' 表示
 
 
  wbObj.WorkSheets(1).Cells(m, 4) = Replace(wbObj.WorkSheets(1).Cells(m, 4), wbObj.WorkSheets(1).Cells(m, 4), CDO.subject)
 
 
         End If
 
 Next m
 
 
 
 
wbObj.Save
 xlObj.Quit
 
-------------------------------------------------------------------------------------

回答
投稿日時: 17/04/30 09:47:01
投稿者: hatena
投稿者のウェブサイトに移動

dum0785 さんの引用:

'=========================================================================
’ココでエラーが出ます。
 
    LastRow = wbObj.WorkSheets(1).Cells(Rows.Count, 1).End(xlUp).Row
 
'=========================================================================


 
この部分だけしか見てません。
Rows.Count だとアクティブなシートを参照することになりますが、アクティブなシートがないからそのようなエラーになるのでは。
 
    LastRow = wbObj.WorkSheets(1).Cells(wbObj.WorkSheets(1).Rows.Count, 1).End(xlUp).Row

 
というようにどのシートなのかを省略せずに記述したらどうですか。
Withを使えば、同じシートの参照を繰り返すのを避けることができます。
 
    With wbObj.WorkSheets(1)
        LastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
    End With

投稿日時: 17/05/02 07:16:34
投稿者: dum0785

hatenaさん
 
ご教示ありがとうございます。無事解決することができました。
ただアクセス上では
Const xlUp As Integer = -4162
という感じで定義が必要なようでした。。。