Excelファイル 修復不可能

Excel側からAccessモジュールを呼び出してExcelへクエリ結果をエクスポートしてますが、そのエクスポートされたファイルをオープンすると頻繁に(5回に１回くらい)「修復不可能」と言う、あのダイアログでメッセージが出ます。同じ条件のDATAでも毎回では無く、普通に成功する時もあります。一連の操作を全てExcel側からvbで行っているので、失敗したり、成功したりで安定せずに困っています。解決方法はあるでしょうか?DATA量はそんなにありません、Sheet数は4Sheetです。

Access側のモジュール

varAccess1 = "Q_内容分類集計"
varAccess2 = "Q_新旧集計"
varAccess3 = "Q_業種別集計"
varAccess4 = "Q_業種別新旧集計"


varExcelPass1 = "\\Cs0097\63022_cr\顧客対応システム\発表資料取込用.xls"
strmsg = "実績を、Excelファイルへ出力します。" & Chr(13) & _
"よろしければ、OKをクリックして下さい。"

If MsgBox(strmsg, vbOKCancel) = vbOK Then

DoCmd.TransferSpreadsheet acExport, _
acSpreadsheetTypeExcel9, varAccess1, varExcelPass1, True
DoCmd.TransferSpreadsheet acExport, _
acSpreadsheetTypeExcel9, varAccess2, varExcelPass1, True
DoCmd.TransferSpreadsheet acExport, _
acSpreadsheetTypeExcel9, varAccess3, varExcelPass1, True
DoCmd.TransferSpreadsheet acExport, _
acSpreadsheetTypeExcel9, varAccess4, varExcelPass1, True
MsgBox """データ出力は、正常に完了しました。"""

End If

Exit Sub

No.2 ベストアンサー 回答者： nicotinism 回答日時： 2011/03/25 14:52

私が伝えたかったのは。

。分かっていただけたようなので書き直しました
あるいは
i= 0
DoCmd ・・・
Do Until isOpend("\\Cs0097\63022_cr\顧客対応システム\発表資料取込用.xls") = 0
i = i + 1 '無限ループ対策
sleep 500
if i = 5 then 'この辺は適当に
msgbox varAccess1 & "で諦めました"
Exit sub 'で良くはないと思えますが取り合えず
loop
i = 0
DoCmd ・・・
以下同様に

Function isOpend(FileFullPath As String) As Integer
Dim fNo As Integer
fNo = FreeFile
On Error Resume Next
Open FileFullPath For Input Access Read Lock Read Write As fNo

Select Case err.Number
Case 0 '多分開かれていない
isOpend = 0
Case 53 'ファイルが見つからない
isOpend = 1
Case 70 '開かれているかも
isOpend = 2
Case Else
isOpend = 3
End Select

Close fNo

End Function
↑大昔の方法なのでご参考までに。
効果があるかは何ともいえませんが (^^ゞ

この回答へのお礼

何度もありがとうございました。
それぞれの処理にsleep関数を付け加えたらどうやら安定したようです。
助かりました(*^_^*)

お礼日時：2011/03/25 15:10

No.1 回答者： nicotinism 回答日時： 2011/03/25 12:10

効果があるか皆目不明ですが（単なる思い付き・・）

Accessの標準モジュールに
'ミリセカンドで停止 sleep 300 など
Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
を追加

DoCmd ・・・
Sleep 500
DoEvents
DoCmd ・・・
以下繰り返し
としてあげたら改善するかもしれません？？
処理がAccess側とExcelファイル側で完了していないのに
次に処理が行ってしまうためではないかと邪推？しました。
Sleep で適当な待ち時間を与えてみたら・・ということです。
ExcelかAccessかどちらか一方で全ての処理を行う方が
間違いはないかと思います。
別案として
Docmd・・
発表資料取込用.xlsを排他で開けるまで待機する処理
誰も開いていなければ上のDocmd・・は終了しているハズ
Docmd・・
とか？

この回答への補足

この回答をヒントにもう少し考えてみました。
一つのエクスポート毎にスリープ時間を設ける。
これでうまく安定すればいいのですが・・

補足日時：2011/03/25 14:28

この回答へのお礼

回答ありがとうございました。

私の説明不足でしたが
既に回答していただいた処置は、Excel側で取っています。
15秒ですが・・短いのでしょうか?
またエクスポートさせるファイルの場所があまりに階層深いのでは無いかとも考えて
場所も移動したりもしました。実行するExcelファイルの階層が深すぎるのでしょうか?
下記↓↓一番最後の行でデバックします。


Application.ScreenUpdating = False

'Accessのdataを取込ます。

Dim 確認 As Integer
Dim DATA転記 As String

DATA転記 = "顧客対応履歴のDATAをEXCELに転記します。全員がファイルを終了していますか?よろしければOKを押してください。"

確認 = MsgBox(DATA転記, vbOKCancel)

If 確認 = vbOK Then

Dim objACCESS As Object
Set objACCESS = CreateObject("Access.Application")
objACCESS.OpenCurrentDatabase "\\Cs0097\63022_cr\顧客対応システム\顧客対応履歴\発表資料用\顧客対応履歴レポート.mdb"
objACCESS.Visible = True
objACCESS.UserControl = True
objACCESS.Run "内容分類EXCEL"
objACCESS.CloseCurrentDatabase
objACCESS.Quit
Set objACCESS = Nothing

'取り込んだファイルが終了するまで15秒間待機する

Application.Wait (Now() + TimeValue("00:00:15"))

'EXCELに転記したDATA(発表資料取込用)を発表資料に取込ます。

Workbooks.Open "\\Cs0097\63022_cr\顧客対応システム\発表資料取込用.xls"

お礼日時：2011/03/25 12:58