| タイトル | ： AccessVBAでエクセルが解放がされない件 |
| 記事No | ： 15841 |
| 投稿日 | ： 2014/02/27(Thu) 17:58 |
| 投稿者 | ： まほろば |
初めまして、まほろばといいます。
まちがえてVB.NETの掲示板に書き込んでしまいました。
再度こちらで質問させていただきたいと思います。
私は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 As Date, myExDate As Date, 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 ADODB.Recordset
Dim conTbl As ADODB.Connection
Dim zzz as Long
Dim myStart as Long
'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.xlsx"
'Excelブックオブジェクト
Set xlApp = CreateObject("New 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.WorksheetFunction.Max(myRange) 'Sale_T.xlsxの最新日付
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
For zzz = 2 To rowCount
If xlSheet.Cells(zzz, 1).Value >= #1/1/2013# Then '2013年から追加更新する
myStart = zzz
Exit For
End If
Next zzz
End If
'///////////////データの取り込み///////////////////////////////////////////////
'1行づつ読み込む
For zzz = myStart To rowCount
'各フィールド
Dim hiz As Date
Dim b As Variant
'レコードの取得
hiz = Format(xlSheet.Range("A" & zzz).Value, "Short Date")
b = xlSheet.Range("B" & zzz).Value
Set rsTbl = New ADODB.Recordset
Set conTbl = Application.CurrentProject.Connection
sql = "SELECT * FROM Sale_T WHERE 日付=#" & hiz & "#"
rsTbl.Open sql, conTbl, adOpenKeyset, adLockOptimistic
If Not rsTbl.EOF Then
rsTbl.MoveFirst
rsTbl.Fields("日付").Value = hiz
rsTbl.Fields("売上").Value = b
rsTbl.Update
Else
rsTbl.AddNew
rsTbl.Fields("日付").Value = hiz
rsTbl.Fields("売上").Value = b
rsTbl.Update
End If
rsTbl.Close
conTbl.Close
Set rsTbl = Nothing
Set conTbl = Nothing
Next zzz
'Excelブックを閉じる
Set myRange = Nothing
Set xlSheet = Nothing
xlBook.Saved = True
xlBook.Close
Set xlBook = Nothing
Set xlBooks = Nothing
xlApp.Quit
Set xlApp = Nothing
End Sub
以上よろしくお願いいたします。
|