複数起動してるエクセルを一括で保存して閉じたい

質問

使用しているのはエクセル2010です。

会社で使用しているソフトで右クリックメニューから
エクセルで出力するという項目があり
それを選択するとbook1、別のも出力するとbook2と
出力されていきます。
（上部に表示されている文字はbook1のみで拡張子はまだ付いていない？）

タスクバー上にはそれぞれが独立して表示されていて
エクセルを閉じようと右上の(チェック)ボタンを押しても
book1ならbook1、book2ならbook2のみのエクセルが終了します
（book1,2を出力して開いていたとしてbook1のエクセルを閉じてもbook2は閉じない）

毎回１０個くらい一気に出力したあと、１つず保存して閉じているのですが
これを簡単にできる方法は何かありませんでしょうか？

見よう見まねでマクロを下記マクロを作ってみましたが
思うように行かず

Sub closeexcel()
Workbooks("Book1").Close SaveChanges:=True
Workbooks("Book2").Close SaveChanges:=True
End Sub

さらにUWSCというソフトを使ってみて
マウスとキーボードの動きを記録してみましたが
これも上手くいきませんでした・・・

もし何か良い案ありましたら
ご教示いただけるよう
よろしくお願いいたします・・・・・

回答No.2

NotFound404 · ベストアンサー

下に続くコードをテキストエディタにコピペして
拡張子はvbsで保存してダブルクリックなどで実行してみてください。
新規未保存はbook & 連番 のファイル名で保存し
既存変更有ファイルは全て上書き保存します。
複数のExcelインスタンス中のBookを順次保存し終了して行きます。

Windows7 64bit & Excel2010 32bit で
検証していますが十分でない場合があります。

もし、
>会社で使用しているソフトで右クリックメニューから
>エクセルで出力するという項目があり
>それを選択するとbook1、別のも出力するとbook2と
>出力されていきます。
が出力のやり直しが出来ないのなら止めてください！
■責任は持てません■

出力されるファイルの大きさによっては
Wscript.Sleep （二か所あり）の数値を大きくする必要があるかも
しれません。

一分ほど経っても「終了しました」のメッセージが出ない場合は
無限ループに陥っている可能性がありますので
タスクマネージャのプロセスタブの中にある
wscript.exe を右クリックし「プロセスの終了」してください。
それにしてもGetObjectは不思議な振る舞いをする。。。

Dim FS
Dim XL, BK
Dim DFname, DF, F
Dim BookCount, Books(), v

Set XL = CreateObject("Excel.application")
DFname = XL.DefaultfilePath '既定の保存先
Set XL = Nothing

Set FS = CreateObject("Scripting.FilesystemObject")
Set DF = FS.getfolder(DFname)

'book & n(nは数字)のファイル名をスキャン
BookCount = 0
For Each F In DF.files
If StrComp(Left(FS.getbasename(F), 4), "book", vbTextCompare) = 0 Then
If IsNumeric(Mid(FS.getbasename(F), 5)) Then
ReDim Preserve Books(BookCount)
Books(BookCount) = Mid(FS.getbasename(F), 5)
BookCount = BookCount + 1
End If
End If
Next

'book & n のnの最大値を取得
If BookCount <> 0 Then
For Each v In Books
If CInt(v) > CInt(BookCount) Then
BookCount = v
End If
Next
End If

Do Until saveXL(BookCount) = True
Wscript.Sleep 500
Loop
MsgBox "終了しました"

Private Function saveXL(ByRef BookCount)
Dim XL, BK
On Error Resume Next
Set XL = GetObject(, "Excel.Application")

Select Case Err.Number
Case 429
saveXL = True
Exit Function
Case 0
'エラーではない
Case Else
saveXL = True
MsgBox "失敗しました" & vbCrLf & Err.Number & vbCrLf & Err.Description
End Select

XL.UserControl = False
For Each BK In XL.workbooks
If BK.Path = "" Then
BookCount = BookCount + 1
BK.saveas XL.DefaultfilePath & "\book" & BookCount
BK.Close
Else
BK.Close True
End If
Next

Do Until XL.workbooks.Count = 0
Wscript.Sleep 200
Loop

XL.Quit
Set XL = Nothing
saveXL = False
End Function

お礼

ありがとうございます！
試してみたら出来ました！
ループに陥った場合の対処法まで
考えていただいていて
至れりつくせりです。
本当にありがとうございました！

回答No.1

mshr1962

下記のURLのVBA「'現在作業中のブック以外の、'他に開いている全てのブックを保存して閉じる。」を参照
http://www.nurs.or.jp/~ppoy/access/excel/xlA003.html

お礼

ありがとうございます！
いま手元にソフトがないので
後で出来るかどうか試してみます。

補足

職場に戻ったのでやってみましたが
閉じれませんでした・・・
ウィンドウが同じなら教えていただいた方法で
保存して閉じられたんですが
エクセルが別ウィンドウで複数起動していると閉じられなかったです・・