ACCESS2003のVBAで改修依頼管理ツールを作成しています。

質問

ACCESS2003のVBAで改修依頼管理ツールを作成しています。

そこで問題が発生してしまい行き詰っています。
問題は改修要望依頼が入ったテーブルを一覧表でEXCEL出力する際に、
2回目の出力を行うと「オブジェクト変数またはWithブロック変数が設定されていません。」
とエラー表示がされ、ここでデバックを使いなにも変更せず終了し、もう一回実行すると
今度は正常に出力されます。つまり正常出力した後にもう一回同じことをするとエラーが出るということです。

オブジェクトの開放もプロシージャの最後で行っているので環境は一回目の出力と変わらないはずなんですが、原因がわかりません。
常に「ActiveWorkbook.Sheets("Sheet1").Name = "改修依頼一覧"」の箇所でとまるので
EXCELアプリケーションの参照が曖昧になっているのでしょうか？
下記はコード一部です。どこに問題があるでしょうか？
参照設定は編集済みです。

'【定数設定】
Const QName As String = "Q_改修依頼内容"
'【変数設定】
Dim cn As New ADODB.Connection
Dim rs As New ADODB.Recordset
Dim xlApp As Object
Dim xlBook As Object
Dim xlSheet As Object
Dim i As Long
Dim strMDBPATH As String 'MDBの保存場所、フォルダー・ディレクトリ
Dim strXLSFILE As String 'テンプレートファイルの名前、e:\xxx\yyyy\テンプレート.xls
Dim strSaveFile As String
Dim ans As Long
Dim strMsg As String
Dim endCol As String

'変数にエクセルアプリケーションをセットして開く
Set xlApp = CreateObject("Excel.Application")
' Set xlBook = xlApp.Workbooks.Open(strXLSFILE)
' Set xlSheet = xlBook.Worksheets("Sheet1")
' xlApp.Visible = True

With xlApp
.Workbooks.Add
.Visible = True
End With

　　ActiveWorkbook.Sheets("Sheet1").Name = "改修依頼一覧"　'エラー発生箇所

Set cn = CurrentProject.Connection

rs.Open QName, cn, adOpenKeyset, adLockReadOnly
ActiveWorkbook.Sheets("改修依頼一覧").Range("A2").CopyFromRecordset rs

'A1セルを選択
Worksheets("改修依頼一覧").Cells(1, 1).Select

'ファイル名を設定
strSaveFile = "改修依頼内容一覧_" & Format(Now, "yyyymmdd_hhmmss") & ".xls"

'名前を変更して保存
ActiveWorkbook.SaveAs FileName:=strMDBPATH & strSaveFile

'データ一覧画面に戻る
DoCmd.SelectObject acForm, "データ一覧画面"

'オブジェクトの開放
Set xlApp = Nothing
Set xlBook = Nothing
Set xlSheet = Nothing
Set rs = Nothing
Set cn = Nothing

Exit Sub

以上です。
編集モジュールなどはエラーに関係ないと思われるステートメントは省略させていただきました。
どなたかご存知の方がいればアドバイスお願いします。

回答No.1

1050 円（@1050YEN） · ベストアンサー

大きく4箇所の修正

↓(1)
>.Workbooks.Add
を
Set xlBook = .Workbooks.Add
へ

↓(2)
>ActiveWorkbook.Sheets("Sheet1").Name = "改修依頼一覧" 'エラー発生箇所
を
Set xlSheet = xlBook.Sheets("Sheet1")
xlSheet.Name = "改修依頼一覧"
へ

↓(3)
>rs.Open QName, cn, adOpenKeyset, adLockReadOnly
>ActiveWorkbook.Sheets("改修依頼一覧").Range("A2").CopyFromRecordset rs
を
rs.CursorLocation = adUseClient
rs.Open QName, cn
xlSheet.Range("A2").CopyFromRecordset rs
へ

↓(4)
>Worksheets("改修依頼一覧").Cells(1, 1).Select
を
xlSheet.Cells(1, 1).Select
へ

お礼

ご回答ありがとうございます。
上記の修正で無事動くプログラムになりました。
またなにかあればお願いします。

回答No.3

piroin654

訂正です。

後半の「さらには」以下は忘れてください。

.Workbooks.Add
を見ていながらすっかり見落としていました。
新規Bookを開いているのでシート名の変更は
できますね。

回答No.2

piroin654

オブジェクトが設定されていない。

>ActiveWorkbook.Sheets("Sheet1").Name = "改修依頼一覧"

　　を

xlApp.ActiveWorkbook.Sheets("Sheet1").Name = "改修依頼一覧"

に変更・・・だけど、

ActiveWorkbook.Sheets("Sheet1").Name = "改修依頼一覧"

　　を

With xlApp
.Workbooks.Add
.Visible = True
End With

の　.Workbooks.Add　の下に同じように設定すればいいのでは。

さらには、Sheet1→改修依頼一覧　の変換が行われた後、逆の
改修依頼一覧→Sheet1の変換がされていないと、二度目にこの
プロシージャの中に入ったときはSheet1は存在しない、
ということで、該当するところでエラーが生じる。

つまるところ、最初からExcelのSheet1を"改修依頼一覧"
にしておき、

.Workbooks.Add
.ActiveWorkbook.Sheets("Sheet1").Name = "改修依頼一覧"

を除くか、

または、このプロシージャを抜けるときに改修依頼一覧→Sheet1
の変換をしてプロシージャを抜けるかのどちらかである。

新規Book作成からはいっているのではないので、最初から
シート名を設定しておき、除くようにしておいたほうが
コードがすっきりしていいのでは、思いますが。
と、このような感じですが。いかがでしょうか。

お礼

ご回答ありがとうございます。
大変参考になりました。
やはり参照が曖昧になっていたのですね。