tagCANDY CGI VBレスキュー(花ちゃん)の Visual Basic 6.0用 掲示板
VBレスキュー(花ちゃん)の Visual Basic 6.0用 掲示板
[ツリー表示へ]  [ワード検索]  [Home]

タイトル AccessVBAでエクセルが解放がされない件
投稿日: 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

以上よろしくお願いいたします。

- 関連一覧ツリー をクリックするとツリー全体を一括表示します)

古いスレッドにレスはつけられません。