none
ACCESSでEXCELを参照しQuitした時のメッセージ抑止方法 RRS feed

  • 質問

  • 初めまして、マロン36と申します。

    複数のEXCELファイルに分かれて管理されている情報をACCESSに取り込み一括管理をしようとしています。

    Workbookからデータを読み込んだ後、次のworkbookを読み込むためにQuitをしているのですが、データは参照しかしておらず更新していなにもかかわらずQuit時に必ず「データを保存しますか? Yes/No」のメッセージが表示され、仕方がないので毎回Noを選択し先に進めています。

    多数のEXCELファイルを読み込むため、「データを保存しますか? Yes/No」の操作が非常に煩わしく、なんとかメッセージ出力を抑止したいのですが、色々な参考資料を見てもメッセージ抑止の方法がわかりません。

    EXCELはACCESSから参照するのみで、更新することはありません。

    どなたかEXCEL Workbookをquitした後に表示される不要なメッセージを抑止する方法をご教示いただけないでしょうか?

    ACCESS、EXCELとも2010を使用していますが、EXCELファイルは他ユーザーとの互換性のために、.xls形式を使用しています。

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

    2016年9月1日 15:13

回答

  • メモのため記録を残させてください。
    ※Office製品はマロン36様より下位バージョンです。

    'ADODBで実行したサンプル
    Sub Test1()
        Dim xlApp As Object         'Excelオブジェクト
        Dim xlBook As Object        'ワークブックオブジェクト
        Dim xlSheet As Object       'ワークシートオブジェクト
        Dim sPath As String         'データベースのパス
        Dim sFilePath As String     'ファイルのパス
        Dim sSheetName As String    'シート名
        Dim sSQL As String          'SQL文
        Dim lRow As Long            'Excelの行位置
        Dim i As Integer            'ループカウンタ
        Dim j As Integer            'ループカウンタ
            
        sPath = Application.CurrentProject.Path
        
        On Error GoTo ErrInfo
        
        Set xlApp = CreateObject("Excel.Application")
        xlApp.Visible = True
        
        Dim cn As ADODB.Connection
        Set cn = CurrentProject.Connection
        Dim cmd As New ADODB.Command
        cmd.ActiveConnection = cn
        cmd.CommandType = adCmdText
        cmd.CommandTimeout = 0
        
        cn.BeginTrans
        
        sSheetName = "Sheet1"
        
        'このサンプルでは3個のエクセルを開いて指定のテーブルに格納しています
        For i = 1 To 3
            sFilePath = sPath & "\test" & CStr(i) & ".xls"
            '-------------------------------------------------------------------------
            'エクセルを読取り専用で開きたい
            '[URL]
            'http://www.accessclub.jp/bbs5/0030/vba9397.html
            '-------------------------------------------------------------------------
            Set xlBook = xlApp.workbooks.Open(FileName:=sFilePath, ReadOnly:=True)
            'Set xlBook = xlApp.workbooks.Open(FileName:=sFilePath, ReadOnly:=False)
            'Set xlBook = xlApp.workbooks.Open(FileName:=sFilePath)
            Set xlSheet = xlBook.worksheets(sSheetName)
            
            sSQL = "delete from tbl" & CStr(i)
            cmd.CommandText = sSQL
            cmd.Execute
                
            lRow = 1
            Do Until xlSheet.cells(lRow, 1).Value = ""
            
                sSQL = "insert into tbl" & CStr(i) & " values("
                For j = 1 To 3
                    If j > 1 Then
                        sSQL = sSQL & ","
                    End If
                    sSQL = sSQL & "'" & xlSheet.cells(lRow, j).Value & "'"
                Next
                sSQL = sSQL & ")"
                cmd.CommandText = sSQL
                cmd.Execute
                
                lRow = lRow + 1
            Loop
            
            xlBook.Close
            '-------------------------------------------------------------------------
            'Don't show Save Dialog box on application quit
            '[URL]
            'http://www.mrexcel.com/forum/excel-questions/162545-dont-show-save-dialog-box-application-quit.html
            'xlBook.Close 0
            '-------------------------------------------------------------------------
            
            '-------------------------------------------------------------------------
            'Excelでブックを閉じるときに表示される"変更を保存しますか?"
            'というメッセージを非表示にする方法
            '[URL]
            'https://support.microsoft.com/ja-jp/kb/213428
            'xlBook.Close savechanges:=False
            '-------------------------------------------------------------------------
        Next
        
        cn.CommitTrans

    ErrInfo:
        If Err.Number <> 0 Then
            dubug.Print Err.Description & "(" & Err.Number & ")"
            cn.RollbackTrans
        End If
        
        cn.Close
        
        xlApp.Quit
        Set xlSheet = Nothing
        Set xlBook = Nothing
        Set xlApp = Nothing
        

    End Sub

    'DoCmdで実行したサンプル
    Sub Test2()
        Dim sPath As String         'アプリのパス
        Dim sFilePath As String     'ファイルのパス
        Dim sSheetName As String    'シート名
        Dim sSQL As String          'SQL文
        Dim i As Integer            'ループカウンタ
            
        sPath = Application.CurrentProject.Path
        
        On Error GoTo ErrInfo
        
        'このサンプルでは3個のエクセルを開いて指定のテーブルに格納しています
        For i = 1 To 3
            sFilePath = sPath & "\test" & CStr(i) & ".xls"
            DoCmd.DeleteObject acTable, "tbl" & CStr(i)
            '-------------------------------------------------------------------------
            'DoCmd.TransferSpreadsheet メソッド (Access)
            '[URL]
            'https://msdn.microsoft.com/ja-jp/library/office/ff844793.aspx
            '-------------------------------------------------------------------------
            DoCmd.TransferSpreadsheet acImport, , "tbl" & CStr(i), sFilePath, False
        Next
        
    ErrInfo:
        If Err.Number <> 0 Then
            dubug.Print Err.Description & "(" & Err.Number & ")"
        End If
        
    End Sub


    2016年9月4日 19:45

すべての返信

  • Workbooksに対して、Close(False)を発行して廻ってからQuitすれば良いです。

    あるいは、参照のみなら、Workbookを開く時にReadOnly属性をつける手もあります。


    jzkey

    2016年9月1日 22:54
  • jokeyさん、ありがとうございます。

    書籍だとなかなか情報が見つからないので大変助かります。

    workbookを開くとき、今は

    Set Workbook1 = CreateObject("Excel Application")

    Workbook1.Workbooks.Open ファイル名

    としてworkbookを開いているのですが、ReadOnlyで開くためには、どのようなオプションをつければ良いのでしょうか?

    なかなか情報が見つからず、ご教示いただけると大変助かります。

    よろしくお願いします。

    2016年9月3日 10:41
  • メモのため記録を残させてください。
    ※Office製品はマロン36様より下位バージョンです。

    'ADODBで実行したサンプル
    Sub Test1()
        Dim xlApp As Object         'Excelオブジェクト
        Dim xlBook As Object        'ワークブックオブジェクト
        Dim xlSheet As Object       'ワークシートオブジェクト
        Dim sPath As String         'データベースのパス
        Dim sFilePath As String     'ファイルのパス
        Dim sSheetName As String    'シート名
        Dim sSQL As String          'SQL文
        Dim lRow As Long            'Excelの行位置
        Dim i As Integer            'ループカウンタ
        Dim j As Integer            'ループカウンタ
            
        sPath = Application.CurrentProject.Path
        
        On Error GoTo ErrInfo
        
        Set xlApp = CreateObject("Excel.Application")
        xlApp.Visible = True
        
        Dim cn As ADODB.Connection
        Set cn = CurrentProject.Connection
        Dim cmd As New ADODB.Command
        cmd.ActiveConnection = cn
        cmd.CommandType = adCmdText
        cmd.CommandTimeout = 0
        
        cn.BeginTrans
        
        sSheetName = "Sheet1"
        
        'このサンプルでは3個のエクセルを開いて指定のテーブルに格納しています
        For i = 1 To 3
            sFilePath = sPath & "\test" & CStr(i) & ".xls"
            '-------------------------------------------------------------------------
            'エクセルを読取り専用で開きたい
            '[URL]
            'http://www.accessclub.jp/bbs5/0030/vba9397.html
            '-------------------------------------------------------------------------
            Set xlBook = xlApp.workbooks.Open(FileName:=sFilePath, ReadOnly:=True)
            'Set xlBook = xlApp.workbooks.Open(FileName:=sFilePath, ReadOnly:=False)
            'Set xlBook = xlApp.workbooks.Open(FileName:=sFilePath)
            Set xlSheet = xlBook.worksheets(sSheetName)
            
            sSQL = "delete from tbl" & CStr(i)
            cmd.CommandText = sSQL
            cmd.Execute
                
            lRow = 1
            Do Until xlSheet.cells(lRow, 1).Value = ""
            
                sSQL = "insert into tbl" & CStr(i) & " values("
                For j = 1 To 3
                    If j > 1 Then
                        sSQL = sSQL & ","
                    End If
                    sSQL = sSQL & "'" & xlSheet.cells(lRow, j).Value & "'"
                Next
                sSQL = sSQL & ")"
                cmd.CommandText = sSQL
                cmd.Execute
                
                lRow = lRow + 1
            Loop
            
            xlBook.Close
            '-------------------------------------------------------------------------
            'Don't show Save Dialog box on application quit
            '[URL]
            'http://www.mrexcel.com/forum/excel-questions/162545-dont-show-save-dialog-box-application-quit.html
            'xlBook.Close 0
            '-------------------------------------------------------------------------
            
            '-------------------------------------------------------------------------
            'Excelでブックを閉じるときに表示される"変更を保存しますか?"
            'というメッセージを非表示にする方法
            '[URL]
            'https://support.microsoft.com/ja-jp/kb/213428
            'xlBook.Close savechanges:=False
            '-------------------------------------------------------------------------
        Next
        
        cn.CommitTrans

    ErrInfo:
        If Err.Number <> 0 Then
            dubug.Print Err.Description & "(" & Err.Number & ")"
            cn.RollbackTrans
        End If
        
        cn.Close
        
        xlApp.Quit
        Set xlSheet = Nothing
        Set xlBook = Nothing
        Set xlApp = Nothing
        

    End Sub

    'DoCmdで実行したサンプル
    Sub Test2()
        Dim sPath As String         'アプリのパス
        Dim sFilePath As String     'ファイルのパス
        Dim sSheetName As String    'シート名
        Dim sSQL As String          'SQL文
        Dim i As Integer            'ループカウンタ
            
        sPath = Application.CurrentProject.Path
        
        On Error GoTo ErrInfo
        
        'このサンプルでは3個のエクセルを開いて指定のテーブルに格納しています
        For i = 1 To 3
            sFilePath = sPath & "\test" & CStr(i) & ".xls"
            DoCmd.DeleteObject acTable, "tbl" & CStr(i)
            '-------------------------------------------------------------------------
            'DoCmd.TransferSpreadsheet メソッド (Access)
            '[URL]
            'https://msdn.microsoft.com/ja-jp/library/office/ff844793.aspx
            '-------------------------------------------------------------------------
            DoCmd.TransferSpreadsheet acImport, , "tbl" & CStr(i), sFilePath, False
        Next
        
    ErrInfo:
        If Err.Number <> 0 Then
            dubug.Print Err.Description & "(" & Err.Number & ")"
        End If
        
    End Sub


    2016年9月4日 19:45
  • msuser_forumさん、うまくいきました。涙が出るほど嬉しい。本当に本当にありがとうございました。
    2016年9月5日 21:21