[[20061019092410]]　『ファイルを２重に開かない様にしたい』（二重瞼）　ページの最後に飛ぶ

『ファイルを２重に開かない様にしたい』（二重瞼）

 こんにちは いつも参考にさせて頂いています

 Sub ファイル指定()
    MsgBox "前バージョンファイルを開いて下さい。"
retry:
    Application.Dialogs(xlDialogOpen).Show
    On Error Resume Next
        If Sheets("sheet1").Range("H1").Value <> "○○○" Then
            MsgBox "無効なファイルです"
            ActiveWorkbook.Close SaveChanges:=False
            GoTo retry
        End If
    On Error GoTo 0
End Sub

 このコードでファイルを指定して開きたいのですが
まちがってファイルを2重に開くと 警告のboxが出て来ます "いいえ"を選ぶと
Application.Dialogs(xlDialogOpen).Show
が黄色くなりコードが止まります
どのようにコードを修正すれば良いのでしょうか
Thisworkbookは指定出来ない様にすることは出来ませんか？

Excel2003 WindowsXP

 こんな感じで回避できませんか？(ROUGE)
'----
Sub ファイル指定()
    MsgBox "前バージョンファイルを開いて下さい。"
retry:
    On Error Resume Next
    Application.DisplayAlerts = False
    Application.Dialogs(xlDialogOpen).Show
        If Sheets("sheet1").Range("H1").Value <> "○○○" Then
            MsgBox "無効なファイルです"
            ActiveWorkbook.Close SaveChanges:=False
            GoTo retry
        End If
    Application.DisplayAlerts = True
    On Error GoTo 0
End Sub

 GetOpenFilenameを使ったらどうでしょうか？
 （注、下記コードは、ローカルドライブにしか対応させてません）
 BJ

 Dim FF As String, WB As Workbook
 FF = Application.GetOpenFilename("エクセルブック (*.xls), *.xls")
 If FF <> "False" Then
   On Error Resume Next
   Set WB = Workbooks(Dir(FF))
   On Error GoTo 0
   If WB Is Nothing Then
      MsgBox Dir(FF) & " は、開いてない。"
      Workbooks.Open (FF)
   Else
      MsgBox Dir(FF) & " は、開いてる。"
   End If
 End If

 ROUGEさん BJさん 回答ありがとうございます

 ROUGEさんに修正して頂いたコードはエラーには 成りませんでしたが
 "いいえ"を選んでも上書きで開いてしまう様です

 BJさんのコードうまく行きました！
 ThisWorkbookを判別して指定のファイルを開くコードが出来そうです＾＾

 ROUGEさん BJさん たいへんありがとうございました
 （二重瞼）

コメント返信：

[ 一覧(最新更新順) ]

[[20061019092410]] 『ファイルを２重に開かない様にしたい』（二重瞼） ページの最後に飛ぶ

[[20061019092410]]　『ファイルを２重に開かない様にしたい』（二重瞼）　ページの最後に飛ぶ