[解決済み] XLSMをCSVで保存しようとすると、「オブジェクト_workbookのメソッドsaveasに失敗しました」エラーが発生する

質問

マクロが使えるExcelワークブックをcsvファイルとして、古いものを上書き保存しようとしています（以下、フォルダとシートの名前を変更する必要がありましたが、それは問題ではないようです）。

 Sub SaveWorksheetsAsCsv()

 Dim SaveToDirectory As String
 Dim CurrentWorkbook As String
 Dim CurrentFormat As Long

 CurrentWorkbook = ThisWorkbook.FullName
 CurrentFormat = ThisWorkbook.FileFormat
 SaveToDirectory = "\MyFolder\"

 Application.DisplayAlerts = False
 Application.AlertBeforeOverwriting = False

 Sheets("My_Sheet").Copy

 ActiveWorkbook.SaveAs Filename:=SaveToDirectory & "My_Sheet" & ".csv", FileFormat:=xlCSV
 ActiveWorkbook.Close SaveChanges:=False
 ThisWorkbook.Activate

 ThisWorkbook.SaveAs Filename:=CurrentWorkbook, FileFormat:=CurrentFormat

 Application.DisplayAlerts = True
 Application.AlertBeforeOverwriting = True

 End Sub

で失敗することがあります。

ランタイムエラー1004：オブジェクト_workbookのメソッドsaveasに失敗しました**)

デバッガで指摘される。

 ActiveWorkbook.SaveAs Filename:=SaveToDirectory & "My_Sheet" & ".csv", FileFormat:=xlCSV

ググってみたところ、試した解決策はいくつかありました。

• ディレクトリが文字列であることを指定する。
• ファイル名やフォルダに特殊文字が含まれないようにする。 ここで )
• .csvとして保存する前に、ワークシートを値としてコピーペーストします（参照 ここで )
• FileFormatを.csvのコード番号で指定する（参照 ここで )
• 一部のアラートの無効化/再有効化
• ActiveWorkbook.SaveAsの行に、パスワードやバックアップの作成など、他のフィールドを追加することができます。

それでも、50～60回くらいは連続で正しく動作して、ある時点でまた失敗することがあります。

このタスクにVBA/Excelを使うのをやめる以外に何か提案があれば、すぐにでもそうしたいのですが、今のところできません。

EDIT: Degustafの提案のおかげで解決しました。Degustafの提案したコードに2つだけ変更を加えました。

• ThisWorkbook.Sheets ではなく CurrentWorkbook.Sheets
• FileFormat:=6 ではなく FileFormat:=xlCSV (より堅牢であるらしい は、異なるバージョンのExcelに対応するために）

Sub SaveWorksheetsAsCsv()

Dim SaveToDirectory As String
Dim CurrentWorkbook As String
Dim CurrentFormat As Long
Dim TempWB As Workbook

Set TempWB = Workbooks.Add

CurrentWorkbook = ThisWorkbook.FullName
CurrentFormat = ThisWorkbook.FileFormat
SaveToDirectory = "\\MyFolder\"

Application.DisplayAlerts = False
Application.AlertBeforeOverwriting = False

ThisWorkbook.Sheets("My_Sheet").Copy Before:=TempWB.Sheets(1)
ThisWorkbook.Sheets("My_Sheet").SaveAs Filename:=SaveToDirectory & "My_Sheet" & ".csv", FileFormat:=6
TempWB.Close SaveChanges:=False

ThisWorkbook.SaveAs Filename:=CurrentWorkbook, FileFormat:=CurrentFormat
ActiveWorkbook.Close SaveChanges:=False

Application.DisplayAlerts = True
Application.AlertBeforeOverwriting = True
End Sub

解決方法は？

私は一般的に ActiveWorkbook がこのような場合の問題です。 つまり、どういうわけかそのワークブック（または他のワークブック）が選択されていないため、Excelがどうすればいいかわからないということです。 残念ながら copy は何も返さないので（コピーしたワークシートがあればいいのですが）、これはこの問題に対する標準的なアプローチ方法です。

そこで、このシートを新しいワークブックにコピーして、そのワークブックへの参照を取得するにはどうすればよいかというアプローチをとります。 新しいワークブックを作成し、そのシートをコピーすることができます。

Dim wkbk as Workbook

Set Wkbk = Workbooks.Add
CurrentWorkbook.Sheets("My_Sheet").Copy Before:=Wkbk.Sheets(1)
Wkbk.SaveAs Filename:=SaveToDirectory & "My_Sheet" & ".csv", FileFormat:=xlCSV
Wkbk.Close SaveChanges:=False

あるいは、このような状況では、さらに優れた方法があります。 WorkSheet がサポートする SaveAs メソッドを使用します。 コピーは必要ありません。

CurrentWorkbook.Sheets("My_Sheet").SaveAs Filename:=SaveToDirectory & "My_Sheet" & ".csv", FileFormat:=xlCSV

ワークブックが開いたままになっている場合は、後で元の名前に再保存するように警告しますが、あなたのコードではすでにそうなっていますね。