| タイトル | ： AccessVBAでエクセルが解放がされない件 |
| 記事No | ： 11221 |
| 投稿日 | ： 2014/02/27(Thu) 14:15 |
| 投稿者 | ： まほろば |
初めまして、まほろばといいます。
VBA歴5年程度の日曜プログラマーです。VB6.0での開発も少しだけ経験がありますが、VB6.0、VBAとも完全にわかっているわけではございませんので質問させていただきたいです。
今、エクセルのシートの時系列の売上データをAccessのテーブルに追加するVBAを作っています。
Access側のコマンドボタンのクリックで下記のVBAを動かそうと思っていました。
テーブルにはエクセルのシートのデータは正しく追加されますが、最後にエクセルが解放されずにプロセスに残ったままになってしまいます。
当サイトを参考にいろいろ調べてやってみたのですが、どうしても解放されず行き詰っています。
本来はVBの掲示板だと理解していますが、VBAでの質問で申し訳ございません。
どうすればうまくいくのか、ご指導よろしくお願いいたします。
環境は、
Windows7ultimate 32bit版 Excel2013,Access2013
です。
(参照設定)
Visual Basic For application
OLE Automation
Microsoft Access 14.0 Object Library
Microsoft ActiveX Data Objects 2.8 Library
Microsoft Excel 14.0 Object Library
Microsoft Windpws Common Controls-2 6.0
(コード)
Private Sub 追加更新日次売上データ()
Dim conAcc As ADODB.Connection
Dim rsAcc As ADODB.Recordset
Dim myDate, myExDate, myAccDate As Date
Dim sql As String
Dim rowCount As Long
Dim filePath As String
Dim xlApp As Excel.Application
Dim xlBooks As Excel.Workbooks
Dim xlBook As Excel.Workbook
Dim xlSheet As Excel.Worksheet
Dim myRange As Object
Dim rsTbl As New ADODB.Recordset
Dim conTbl As ADODB.Connection
'Sale_Tの最新の日付を取得
Set rsAcc = New ADODB.Recordset
Set conAcc = Application.CurrentProject.Connection
' SQL文作成
sql = "SELECT * FROM Sale_T ORDER BY [Sale_T].日付; "
rsAcc.Open sql, conAcc, adOpenDynamic, adLockOptimistic, adCmdText
rsAcc.MoveLast
myAcDate = rsAcc("日付").Value 'Sale_Tの最新日付
rsAcc.Close
conAcc.Close
Set rsAcc = Nothing
Set conAcc = Nothing
'//////////////////////////////////////////////////////////////////////////////
'エクセルのパス
filePath = "D:\売上\日次売上\SalesDay.xlsm"
'Excelブックオブジェクト
Set xlApp = CreateObject("Excel.Application")
Set xlBooks = xlApp.Workbooks
Set xlBook = xlBooks.Open(filePath) 'ファイルパスのExcelブックを開く
'ワークシートオブジェクト
Set xlSheet = xlBook.Worksheets(1) '1枚目のワークシート
xlApp.Visible = True
'ワークシート内レコードの最新日付を取得する
rowCount = xlSheet.Range("A1").End(xlDown).Row
xlSheet.Select
Set myRange = xlSheet.Range(xlSheet.Cells(1, 1), xlSheet.Cells(rowCount, 1))
myExDate = xlApp.Application.WorksheetFunction.Max(myRange) 'IR(20).xlsmの最新日付
myAccDate = Format(myAcDate, "Short Date")
myExDate = Format(myExDate, "Short Date")
If myAccDate >= myExDate Then 'Accessテーブルの最新日付よりエクセルの最新日付が遅ければExitする
'Excelを閉じる
Set myRange = Nothing
Set xlSheet = Nothing
xlBook.Saved = True
xlBook.Close
Set xlBook = Nothing
Set xlBooks = Nothing
xlApp.Quit
Set xlApp = Nothing
MsgBox ("追加データはありません。")
Exit Sub
Else
以下省略
|