AccessVBAでのExcelメモリ解放

はじめまして。
仕事でAccessVBAを使ってExcelのデータを操作するプログラムを作っています。

やりたいこと
(1)日付と店番・店名が入力されているExcelを開く
(2)削除日=C列からオートフィルで空白（日付が入力されていないもの）を絞りだす
(3)日付=B列からオートフィルで本日の日付より１ヶ月前の日付を搾り出す
(4)もし本日より１ヶ月前の日付があれば、C列の削除日に本日の日付を入れる
(5)印刷

問題点
・動作が不安定
・Excelのメモリ解放がおかしいのか、プログラム終了後別件でエクセルを開くと
　ビジー状態になり「応答なし」になってしまう
・プログラム内でAccessテーブルのデータを既存のExcelファイルの最終行に
追加で出力したいが、なぜかAccessテーブルの名前で新規シートが作られ、そこに
データが入ってしまう

色々なサイトを見ましたが、どこがおかしいのか分からず。
どなたか知恵をお貸しいただけますでしょうか。

Private Sub cmd_insert_Click()

On Error GoTo Error

Dim App As Object '　Application Object
Dim Wkb As Object '　Excel.Workbook Object
Dim Wsh As Object '　Excel.WorkSheet Object
Dim Kensu As Integer '　削除データ件数格納
Dim cnt As Integer '　件数カウント
Dim lngYLine As Long '　対象となる列の番号
Dim intXLine As Integer '　対象となる行の番号

Dim strac As String '　Accessテーブル名
Dim strxls As String '　出力先ファイルのパス
Dim strmsg As String '　メッセージボックスへのメッセージ格納
Dim strans As String '　削除対象日付格納


'Excelファイルをセット
Set App = CreateObject("Excel.Application")
App.Visible = True
Set Wkb = App.WorkBooks.Open("C:\Downloads\記録.xls")　←わざと変なURLにしています
Set Wsh = Wkb.Worksheets("HP")

'出力先ファイル指定
strxls = "C:\Downloads\記録.xls"

'Accessテーブルに入力したデータをExcelファイルへ出力
strac = "tbl_募集データ"

strmsg = strac & " を、Excelファイルへ出力します。" & Chr(13) & _
"出力先は" & strxls & "、 シート名はHPです。" & _
Chr(13) & "よろしければ、OKをクリックして下さい。"

'★★excelシートの最終行に追加でデータを入れたい★★
' If MsgBox(strmsg, vbOKCancel) = vbOK Then
'
'
' '最初のデータをフィールド名として使う
' DoCmd.TransferSpreadsheet acExport, _
' acSpreadsheetTypeExcel9, strac, strxls, True
' MsgBox "データ入力正常完了！"
'
' End If

'オートフィルで「削除日」の行が空白のものを選択 ※削除日はC行目固定とする
Wsh.Range("C1").CurrentRegion.AutoFilter Field:=3, Criteria1:="="

'本日分の削除データのチェック（本日より１ヶ月前の日付のものを搾り出す）
strans = Format(DateAdd("d", -30, Date), "mm/dd")

Wsh.Range("B1").CurrentRegion.AutoFilter Field:=2, Criteria1:=strans

If Wsh.AutoFilter.Range.Columns(1).SpecialCells(xlCellTypeVisible).Count = 1 Then

MsgBox "本日は削除データがありません"

Else
'削除データ件数取得
Kensu = (Wsh.AutoFilter.Range.Columns(1).SpecialCells(xlCellTypeVisible).Count) - 1

MsgBox "削除データあり、件数は" & Kensu & "件でした"

lngYLine = Wsh.Cells.Find(strans).Row
intXLine = Wsh.Cells.Find(strans).Column

For cnt = 1 To Kensu

'削除日の列に本日の日付を入力
Wsh.Range("C" & CStr(lngYLine)).Value = Format(Date, "mm/dd")
lngYLine = lngYLine + 1

Next

'削除対象範囲を印刷
If MsgBox("印刷しますか？", vbQuestion + vbYesNo) = vbYes Then

'シートの指定
Wsh.Activate
App.Visible = False

Wkb.Application.ScreenUpdating = False
Wsh.Visible = True
Wsh.PrintOut
Wsh.Visible = False


End If

End If

'オートフィルを元に戻す
If Wsh.FilterMode = True Then
Wsh.ShowAllData
End If

MsgBox ("正常終了しました！")

'上書き保存
Wkb.Save

'Only XL 97 supports UserControl Property
On Error Resume Next

'App.UserControl = True
Wkb.Close SaveChanges:=False
App.Quit

Set Wsh = Nothing
Set Wkb = Nothing
Set App = Nothing

Exit Sub

Error:

If Err.Number = 3044 Then
MsgBox "パスの指定が誤っている可能性があります。", vbCritical
Else
MsgBox "予期せぬエラーが発生しました。", vbCritical
End If

App.UserControl = True
Wkb.Close
App.Quit

Set Wsh = Nothing
Set Wkb = Nothing
Set App = Nothing
End Su

No.1 回答者： nicotinism 回答日時： 2013/12/20 21:44

問題なさそうな気がしますけど・・・

分かんね。。

という時に、もし影のExcel プロセスが立ち上がっているために問題発生なら。
私は、タスクマネージャを立ち上げ、オプションの「常に手前に表示」して
プロセスタブで、Excel が新たに表示されないかを確認しています。
アナログ的ですが他に方法を知らないので。。

コードの方は適当なところにブレークポイントをいくつか設定し
F8 や F5 でステップ実行します。
Excel が増えたらそこが原因です。

ここはご存知かもしれませんが
Excel のタスクを正常に終了できない現象
http://hanatyan.sakura.ne.jp/vbhlp/ExcelErr.htm
（VB6もVBAも変わりありません）

原因が分かりましたら、私メにも教えてください。

>追加で出力したいが、なぜかAccessテーブルの名前で新規シートが作られ、そこにデータが入ってしまう
CopyFromRecordset も考えてみてください。
http://www.sanryu.net/acc/tips/tips252.htm