[[20061120171246]]　『実行時エラー　2147217911(80040e09) 　ページの最後に飛ぶ

『実行時エラー　2147217911(80040e09)

 データベースまたはオブジェクトは読み取り専用なので、更新できません。』（yo）

 いつも勉強させて頂いています。
 タイトルのとおり、VBA実行中に出てしまうエラーの対処方法をお教え下さい。

 コードは以下の通りです。

 Public Function 入荷遅れデータ更新処理() As Boolean

    Dim vTuki       As Variant
    Dim aRs         As New ADODB.Recordset
    Dim sSql        As String
    Dim iRet        As Integer
    Dim bRet        As Boolean
    Dim iRow        As Integer

    入荷遅れデータ更新処理 = False

    vTuki = Right(gsTo, 4)

    sSql = "SELECT 入荷遅れ.支店, 入荷遅れ.支店№, 入荷遅れ.未供給率,入荷遅れ.データ年月"
    sSql = sSql & " FROM 入荷遅れ"
    sSql = sSql & " WHERE (((入荷遅れ.データ年月) = '" & vTuki & "'))"
    sSql = sSql & " GROUP BY 入荷遅れ.支店, 入荷遅れ.支店№, 入荷遅れ.未供給率,入荷遅れ.データ年月;"
    aRs.Open sSql, goDbSConnection, adOpenDynamic, adLockOptimistic

    If aRs.EOF Then
        gsPath = gsData
        bRet = FolderExists(gsPath, True)
        'ファイル名作成
        gsFile = Right(gsTo, 4) & gsFName2 & ".xls"
        'ファイルがあるか確認
        If Dir(gsPath & gsFile) <> "" Then
            'データ取込
            Workbooks.Open (gsPath & gsFile)
            Workbooks(gsFile).Activate
            iRow = 6        'データ開始行（高崎）
            For iRow = 6 To 20    'データ最終行（全社）19
                With ActiveSheet
                    aRs.AddNew
                    aRs.Fields("支店") = .Cells(iRow, c支店)
                    aRs.Fields("支店№") = .Cells(iRow, c支店№)
                    aRs.Fields("未供給率") = Round(.Cells(iRow, c未供給率).Value, 4)
                    aRs.Fields("データ年月") = vTuki
                    aRs.Update
                End With
            Next iRow
            aRs.Close
            Workbooks(gsFile).Close savechanges:=False
            '過去データへファイル移動
            Call MoveFile(gsFile, gsData, gsKako)
            入荷遅れデータ更新処理 = True
        Else
            If OKCMsg("非常備品入荷遅れデータがありません。" & vbCrLf & _
                "データを作成してから再度実行して下さい。" & vbCrLf & vbCrLf & _
                "データを作成しますか？") = vbOK Then
                Sh入荷遅れ.Copy
                ActiveWorkbook.SaveAs Filename:=gsPath & gsFile
                IMsg ("上書き保存して終了して下さい。")
                入荷遅れデータ更新処理 = False
            Else
                If OKCMsg("入荷遅れデータなしで作成します。") = vbOK Then
                    入荷遅れデータ更新処理 = True
                Else
                    入荷遅れデータ更新処理 = False
                End If
            End If
        End If
    Else
        入荷遅れデータ更新処理 = True
    End If

 End Function

 aRs.Openでアクセスのデータベースを開いた後、データがなかったら
 エクセルのデータをアクセスにセットする。
 とやりたかったのですが、
 aRs.AddNewのところで、
 「実行時エラー　2147217911(80040e09)
 データベースまたはオブジェクトは読み取り専用なので、更新できません」
 となってしまいます。
 最初は動いていたのですが、他を編集していたら動かなくなってしまいました。
 コードを全部戻してみたりしましたが結果は同じです。
 マイクロソフトの回避策で、エクセルのブックの方を上書き保存などしてみましたが
 同じでした。
 拡張子の問題もあるようなのですが、これはxlsとなっています。

 どうしたら良いか教えて下さい。

 「実行時エラー　2147217911(80040e09)」をググったら一件見つかりましたよ
http://support.microsoft.com/kb/837017/ja　の中の

http://support.microsoft.com/kb/824388/　です

 これによると
 「この問題は、 SharePoint Portal Server 2001 Service Pack 3 に最初に修正されました。」
 　　　と書いてありますよ

 （dack）

コメント返信：

[ 一覧(最新更新順) ]

[[20061120171246]] 『実行時エラー 2147217911(80040e09) ページの最後に飛ぶ

[[20061120171246]]　『実行時エラー　2147217911(80040e09) 　ページの最後に飛ぶ