エクセルVBAで、ある特定な場所にあるブックが開いていたら閉じたい

質問

こちらでお世話になった者です。その節はありがとうございました。
http://okwave.jp/qa3972230.html

他のブックが開いているとエラーになるので、フォームのブックが開いていたら、
マクロの最初に閉じてしまいたいと思います。

dbase.xls
formフォルダ
　001.xls
　002.xls
　003.xls

のようなフォルダ構造になっていて、001～003.xlsは入力フォームです。
dbase.xlsを開いて、マクロを貼り付けたボタンをクリックすると、すべてのフォームの
データがdbase.xlsに取り込まれます。

↓のような感じで、最初にメッセージが表示されるようにしたのですが、
自分以外の、formフォルダにあるブックが開いていたらそれをすべて閉じる
方法を教えていただけますか。

Sub data_torikomi()
MsgBox ("開いている他のエクセルブックをすべて閉じてください")
Dim Fn As String
Dim myPath As String
Dim dbBkSh As Worksheet
Dim i As Long
Set dbBkSh = Workbooks("dbase.xls").Worksheets("一覧表")
myPath = ThisWorkbook.Path & "\"
Fn = Dir(myPath & "form\*.xls")
i = 1
　　……

回答No.2

Wendy02 · ベストアンサー

こんばんは。

ちょっと考えてみました。

Sub data_torikomi()
Dim wb As Workbook
Dim Fn As String
Dim myPath As String
Dim dbBkSh As Worksheet
Dim i As Long
For Each wb In Workbooks
　If wb.Name <> ThisWorkbook.Name And _
　InStr(1, wb.FullName, "form\", 1) > 0 Then　'formを検索
　　 wb.Close False　'閉じる
　End If
Next wb
myPath = ThisWorkbook.Path & "\"
Set dbBkSh = Workbooks("dbase.xls").Worksheets("一覧表")
Fn = Dir(myPath & "form\*.xls")
i = 1
'・
'・
'・
End Sub

なんとなく、良く分からないのは、ThisWorkbook　の存在は、とういう立場にあるのだろうかって思います。このままだと、アドインスタイルです。ただ、アドインは、Workbooks には掛からないです。

ところで、おまけですが、開いている他のExcelブックをすべて閉じるのは、このようにします。メッセージは、しばらく開いていますが、自動的に閉じます。つまり、このブックだけにしますが、PEROSNAL.XLS は、残します。

'開いているブックを、本体だけ残して閉じてしまうマクロ
Dim ret As Integer
ret = CreateObject("WScript.Shell").Popup("開いている他のエクセルブックをすべて閉じます", 3, "CloseMessage", 1)
If ret = 2 Then Exit Sub
For Each wb In Workbooks
　If (Not StrConv(wb.Name, vbUpperCase) Like "PERSONAL.XLS") _
　 And (wb.Name <> ThisWorkbook.Name) _
　 And (wb.Name Like "Book#") Then
　　wb.Close False
　End If
Next wb

お礼

いろいろと教えていただきまして、ありがとうございます。
上に書いていただいたコードできれいに目的を達成することができました。

私自身アドインがなんなのかよくわからないのですが、ThisWorkbookは、dbase.xlsです。
上書き保存したいファイルは、dbase.xlsのルートの中にあるformフォルダにあります。
ですからWorkbooksに掛からなくても問題ないということでしょうか。

どうもありがとうございましたm(_ _)m。

回答No.3

Wendy02

こんばんは。

>私自身アドインがなんなのかよくわからないのですが、ThisWorkbookは、dbase.xlsです。

まあ、アドインにすることはないですけれども、dbase.xls と違うブックから操作するのかと思いました。

そうすると、
Set dbBkSh = Workbooks("dbase.xls").Worksheets("一覧表")

どちらでも同じことですが、ここの部分は、
Set dbBkSh = ThisWorkbook.Worksheets("一覧表")
で済みますね。

お礼

ご回答ありがとうございます！

そうすると、ファイル名が変わってもこのマクロを動かすことができるようになり、大変便利になりました！

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

回答No.1

mitarashi

こんなところでどうでしょう。
参考URLのコードを参考にさせていただきました。
フォルダー名は目的のものに変更してください。
また、マクロは dbase.xls 内に記述してください。
Sub test()
Dim WBK As Workbook
Dim strOwnBook As String

strOwnBook = ThisWorkbook.Name
For Each WBK In Workbooks
If WBK.Name <> strOwnBook Then
If WBK.Path = "C:\Documents and Settings\?????\My Documents" Then
Call WBK.Close(savechanges:=False)
End If
End If
Next WBK
End Sub

参考URL：

http://www.asahi-net.or.jp/~ef2o-inue/vba_o/sub05_010_020.html

お礼

コメントありがとうございます。
参考になりました。
今回の場合、フォームを配布してデータベースを回収するという使い方になりますので、あまりパスにこだわらない方が使い勝手が良さそうに感じました。

どうもありがとうございましたm(_ _)m
またよろしくお願いします。