Excel VBAにて別のExcelファイルを開く

質問

現在、ExcelファイルVBAにて別のExcelファイルを開こうとしています。FileSystemオブジェクトを利用してオープンはできるのですが、当然そのファイルをどなたかが利用していると「書き込みできません」とのメッセージが出てきます。これを回避するためにオープンするExcelファイルがすでに誰かに開かれているかを判定できる方法はございませんか？WSHやAPIを利用してもかまいません。以下にロジックを書いておきますので、どうかよろしくお願いいたします。緊急度は大変高いです。

'ErrorFileフォルダ内のエクセルファイルが存在するかを判定
Do Until fs.FileExists(buff) = False

'ErrorFile内のエクセルファイルを取得
Set f = fs.GetFile(buff)

'FileSystemオブジェクトでErrorFile\logフォルダ内の同一名称ファイルが存在するかを判定
If fs.FileExists(f.ParentFolder & "\log\" & f.Name) = True Then
'存在していたら、ファイルを削除　←この部分で誰かがファイルを開いているとエラー　
　　　　　　fs.DeleteFile f.ParentFolder & "\log\" & f.Name
End If

'ErrorFileフォルダ内のファイルをErrorFile\logフォルダに移動
fs.MoveFile f.Path, f.ParentFolder & "\log\" & f.Name
'マクロが動作しているパスにErrorFileフォルダ内のエクセルファイル名をフルパスで取得
buff = ActiveWorkbook.Path & "\ErrorFile\" & Dir("ErrorFile/*.xls", vbSystem)

Loop

どうか、解決策を返信いただければ幸いです。

回答No.3

goota33

読み込んだブックが読み取り専用かどうかを判定するには
WorkbookコレクションのReadOnlyプロパティを使います。
この方法以外の手法もいろいろ試してみましたが、エラートラップを使う方法以外では
ReadOnlyプロパティを使う手法でしか読み取り専用かどうかの判定をしてくれませんでした。
以下に読み込んだブックが読み取り専用だった場合はその旨のメッセージを出力して
ループ文を抜けるソースを書いておきます。
動作チェックはしてないので何かしらエラーが出るかもしれません。

'開いたブックを格納する変数を宣言
Dim wbkOpenIndexFile As Workbook

'ErrorFileフォルダ内のエクセルファイルが存在するかを判定
Do Until fs.FileExists(buff) = False
'ErrorFile内のエクセルファイルを取得
Set f = fs.GetFile(buff)

'FileSystemオブジェクトでErrorFile\logフォルダ内の同一名称ファイルが存在するかを判定
If fs.FileExists(f.ParentFolder & "\log\" & f.Name) = True Then
'画面描画を停止
Application.ScreenUpdating = False
'これから削除しようとするブックを開いて宣言した変数に代入
Set wbkOpenIndexFile = Workbooks.Open(f.ParentFolder & "\log\" & f.Name)
'開いたブックが読み取り専用かどうかを確認
If wbkOpenIndexFile.ReadOnly = True Then
MsgBox "誰かがファイルを開いてます。", vbExclamation
'ブックを閉じるときに保存するかどうかの確認ダイアログボックスが表示されないようにする
Application.DisplayAlerts = False
'開いたブックを閉じる
wbkOpenIndexFile.Close
'ブックを閉じるときに保存するかどうかの確認ダイアログボックスが表示されるようにする
Application.DisplayAlerts = True
'画面の描画を再開する
Application.ScreenUpdating = True
'ループ文を抜ける
Exit Do

Else
Application.DisplayAlerts = False
wbkOpenIndexFile.Close
Application.DisplayAlerts = True
Application.ScreenUpdating = True
fs.DeleteFile f.ParentFolder & "\log\" & f.Name

End If
End If

'ErrorFileフォルダ内のファイルをErrorFile\logフォルダに移動
fs.MoveFile f.Path, f.ParentFolder & "\log\" & f.Name
'マクロが動作しているパスにErrorFileフォルダ内のエクセルファイル名をフルパスで取得
buff = ActiveWorkbook.Path & "\ErrorFile\" & Dir("ErrorFile/*.xls", vbSystem)

Loop

回答No.2

singlecat

Openステートメントで "LOCK"オプションをしてしてオープンして、
正常にオープンできなかったら、OnErrorで処理するのも良いし、

Deleteで失敗した時に上記同様OnErrorで処理しても良いと思います。

なお、この時処理が完了したら、OnErrorを元の状態に戻してくださいね。

回答No.1

excelist

On Error文でエラー対処する方法でいかがでしょう？

参考ＵＲＬ
http://officetanaka.net/excel/vba/tips/tips108.htm