ActiveWorkbook.SaveAsが失敗

質問

Excel2010です。
以下はdataシートからtestシートに値をコピーし、testシートを別ファイルとして保存させるだけの単純なVBAです。
Sub TEST01()
　　Dim wb As Workbook
　　Dim ws As Worksheet, ns As Worksheet
　　Dim myC As Range
　　Dim n As Long

　　Set wb = ThisWorkbook
　　Set ws = wb.Worksheets("test")

　　With wb.Sheets("data")
　　　　For Each myC In .Range("A1", .Range("A1").End(xlDown))
　　　　　　wb.Activate
　　　　　　ws.Range("A1:C1").Value = myC.Resize(1, 3).Value
　　　　　　n = n + 1
　　　　　　ws.Copy
　　　　　　Set ns = ActiveSheet
　　　　　　ns.Name = "test" & Format(Date, "YYYYMMDD")
　　　　　　Call ファイル作成(ns)
　　　　Next
　　End With
　　ws.Select
　　MsgBox n & " 件の作業を終了しました。"
End Sub

Sub ファイル作成(ByRef ns As Worksheet)
　　Dim Fdr As String, Fn As String
　　Dim myStr As String

　　With ns
　　　　.Activate
　　　　.Buttons.Delete
　　　　Fdr = ThisWorkbook.Path & "\" & Format(Date, "YYYYMMDD" & "作成分") '保存先
　　　　If Dir(Fdr, vbDirectory) = "" Then
　　　　　　 MkDir Fdr '無ければ作成
　　　　End If
　　　　DoEvents
　　　　myStr = IIf(Trim(.Range("C1").Value) = "", "", "-" & Trim(.Range("C1").Value))
　　　　Fn = .Range("A1").Value & "_" & .Range("B1").Value & myStr & ".xlsx"　 '
　　　　Application.StatusBar = Fn & " ファイル作成中"
　　　　ActiveWorkbook.SaveAs Filename:=Fdr & "\" & Fn
　　　　ActiveWorkbook.Close (False)
　　End With
　　Application.StatusBar = ""
End Sub

自分の端末内で動かして問題なく作動します。
ところがネットワークでつながった会社のサーバー内の、部門内共有フォルダーに保存して実行すると1番目のデータは問題なく動き、ちゃんとファイルも保存されるのですが2番目でActiveWorkbook.SaveAsのところで実行時エラーがでます。
個人の端末ではちゃんと作動するのでデータのせいではないとは思いつつ、別のデータにしてみてもやはり2番目は同じエラーが出ます。
ファイル保存するシートにはそのシート内を参照する数式があるだけで、ボタン以外のオブジェクトはありません。（ボタンも保存前にDeleteしてます）
何が原因で端末ならOKのものが共有フォルダーでだめなのかまったくわかりません。どなたかお知恵をおかしください。

回答No.7

kkkkkm · ベストアンサー

毎回新しいCopyシートでブックを作らずに、決まった作業用ブックにデータを代入してそれを名前を付けて保存しなおしていくとどうなんでしょう。

お礼

ありがとうございます。明日、会社で試してみます。

補足

本日、別ファイルにしたTESTシートをSaveCopyAsで保存するやりかたでやったところ、共有フォルダ内でもテストケース100件が無事作動しました。
でも、なんでコピーしたシートをActiveWorkbook.SaveAsでは2件目でエラーになるのかまだ腑に落ちません。

回答No.8

kkkkkm

> なんでコピーしたシートをActiveWorkbook.SaveAsでは2件目でエラーになるのかまだ腑に落ちません。

よくわかりませんが、SaveCopyAsをActiveWorkbookではなくブック指定(Setして)だとしたら、そのあたりの違いが出たのかもしれませんね。Setだとオブジェクト参照変数使用でActiveWorkbookはプロパティ使用で動作に微妙な差が出たとか(適当な事を言ってますm(__)m)

お礼

なんどもありがとうございました。

回答No.6

HohoPapa

ソースコードをざっくりとしか見ていませんので
外しているかもしれませんが、
マクロブック込みの自身（ThisWorkbook）のシートを編集し
自身を保存して閉じ
再び、自身をActivateにするコードのように思います。

ローカルで実行させると期待通り動作しているとのことから
間違いではないものと思いますが、
私ならやりませんし、無謀と思います。

私だったら、
Dim nb As Workbook
Set nb = Workbooks.Add
といったコードで新たなブックを開き
そのブックに必要な編集（自身のシートの複写など）を行い、
nbを保存し、閉じる作業を必要回数繰り返す制御にします。

お礼

ありがとうございます。
＞自身を保存して閉じ
いえ、一つのシートをコピーし、別Bookとして保存しているだけなんですが、これってそんなに無謀なことだったのでしょうか？
Set nb = Workbooks.Add　の方法も考えてみます。ありがとうございました。

補足

本日、 Workbooks.Add　でやってみました。
共有フォルダ内でもテストケース100件が無事作動しました。
でも、なんでコピーしたシートをActiveWorkbook.SaveAsでは2件目でエラーになるのかまだ腑に落ちません。

回答No.5

masnoske

> チェックをループで回し、存在すれば書き込んでループを抜ける。

チェックをループで回し、存在すればループを抜けて書き込む。

回答No.4

masnoske

時間待ちで改善するのであれば、サーバーの処理とPCの処理で時間差が生じているのかも知れません。
前回保存したファイル名を変数に記録しておき、ファイルを保存する前に前回のファイルが存在するかどうかをチェックしてみてはどうでしょうか。
チェックをループで回し、存在すれば書き込んでループを抜ける。

お礼

ありがとうございます。
以下のようにDo　Loopして、保存されてから次にうつるようにしてみましたが、やはり2件目でエラーとなりました。
フォルダ内に2件目のファイルができているのに、なんとサイズが0で、ひらくことができないおかしなファイルでした。。

Sub ファイル作成(ByRef ns As Worksheet)
Dim Fdr As String, Fn As String
Dim myStr As String, myFn As String

With ns
.Activate
.Buttons.Delete
Fdr = ThisWorkbook.Path & "\" & Format(Date, "YYYYMMDD" & "作成分") '保存先
If Dir(Fdr, vbDirectory) = "" Then
MkDir Fdr '無ければ作成
End If
myStr = IIf(Trim(.Range("C1").Value) = "", "", "-" & Trim(.Range("C1").Value))
Fn = .Range("A1").Value & "_" & .Range("B1").Value & myStr & ".xlsx" '
Application.StatusBar = Fn & " ファイル作成中"
' Application.Wait Now() + TimeValue("00:00:01")
ActiveWorkbook.SaveAs Filename:=Fdr & "\" & Fn
Do Until Dir(Fdr & "\" & Fn) <> ""
DoEvents
Loop
ActiveWorkbook.Close (False)
End With
Application.StatusBar = ""
End Sub

補足

Do Until Dir(Fdr & "\" & Fn) <> ""
DoEvents
Loop
Do Until FileLen(Fdr & "\" & Fn) ＞9000
DoEvents
Loop
もやってみましたが同じでした。

回答No.3

masnoske

以下の環境でテストしてみましたが、問題ありませんでした。
WIn10 + Excel2010
１．個人PC内のフォルダ
２．個人だけが読み書き可能な共有サーバー内のフォルダ
３．他人も読み書き可能な共有サーバー内のフォルダ

ステップインで実行しても、２件目でエラーが出ますか？
ステップインで問題なければ、ActiveWorkbook.SaveAs の前に時間待ちの処理を入れてみてはどうでしょうか。

お礼

ありがとうございます。
ステップインでゆっくり実行するとエラーは出ませんでした。しかしFor　Nextで件数が多いのでF8を連打し続けたら5件目でエラーが出ました。
ご教示の時間待ちの処理で、ActiveWorkbook.SaveAs の前にApplication.Waitで3秒入れたらやはり5件目でエラー。5秒にしたら7件目でエラー。10秒にしたら全件（15件）OKでした。
いまはまだテスト段階ですが本番移行したら数百件の処理になるので何秒待ちにすればいいのか悩んでいます。

回答No.2

merrysun

そのファイルをデスクトップにコピーして動くかやってみて下さい

お礼

ありがとうございます。
はい、自分の端末のデスクトップでやってみましたが、正常に動きました。
自宅で個人のPCのエクセル2016のデスクトップでもやってみましたがやはり正常に動きました。

回答No.1

kkkkkm

Set ns = Nothing
を入れてみるとか
ActiveWorkbook.SaveAsでエラーで止まった時に各変数の値がどうなっているのか見てみてはいかがでしょう。

お礼

ありがとうございます。Set ns = Nothing　やってみましたが結果は同じでした。
止まった時に各変数の値も調べましたが、すべて想定通りで変なのはありませんでした。