マクロ対応の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
私はグーグルで試しましたが、いくつかの解決策がありました:
それでも、連続して最大50〜60回正常に実行された後、ある時点で再び失敗する可能性があります。
このタスクにVBA/Excelの使用を停止する以外の提案は、すぐに行われますが、今のところはできません。
編集:デグスタフの提案のおかげで解決しました。 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
は何も返さないので(コピーされたワークシートはNiceです)、これはこの問題に対処する標準的な方法です。
したがって、このシートを新しいワークブックにコピーし、そのワークブックへの参照を取得する方法として、これにアプローチできます。できることは、新しいブックを作成してからシートをコピーすることです。
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
ワークブックを開いたままにしておく場合は、ワークブックを後で元の名前に再保存するよう警告しますが、コード内に既に持っています。
これは1年ですが、将来の読者のために何かを追加します
MicrosoftはExcelエラーとは見なしていないため、実行時エラー1004のExcelヘルプには多くのドキュメントはありません。
上記の答えは100%有効ですが、問題の原因を知ることが役立つ場合があります。これにより、問題を回避したり、早期に修正したり、より簡単に修正したりできます。
これは断続的な障害であり、フルパスとファイル名で保存することで修正されるという事実は、マクロが自動ファイル回復後に自動回復ディレクトリに.xlsbファイルを保存しようとしている可能性があることを示しています。
または、自分でファイルのパスまたはファイル名を編集した可能性があります。
以下を使用してパスとファイル名を確認できます。-MsgBox ThisWorkbook.FullName
このようなメッセージボックスが表示されます。
C:\ Users\Mike\AppData\Roaming\Microsoft\Excel\DIARY(バージョン1).xlxb
その場合、解決策は(他の人が上記で述べたように)ファイルを正しいパスとファイル名で保存することです。これは、VBAを使用して、または手動で実行できます。
数秒かかる自動回復アクションの後、当然のことながら、正しいパスとファイル名でファイルを手動で保存する習慣になりました(これが毎日発生しない場合)。したがって、マクロを実行すると、このエラーは発生しません。回復直後に手動で.xlxbファイルを.xlsmファイルに保存するという私の習慣は、ワークシートを提供する初心者には役に立たないことを忘れないでください。
このエラーの後:で作成したワークシートにハイパーリンクがある場合 Ctrl+k おそらく、「AppData\Roaming\Microsoft \」、「\ AppData\Roaming \」、「../../ AppData/Roaming /」または「....\My documents\My documents」のようになります\ "ファイル回復後の複数のハイパーリンク。これらを回避するには、ハイパーリンクをテキストボックスに添付するか、HYPERLINK関数を使用して生成します。
それらの特定と修復はもう少し複雑です
まず、ハイパーリンクを調べて、エラーのある文字列と各エラーの正しい文字列を特定します。時間が経つにつれて、私はいくつかを見つけました。
Excelでは、[特別に移動]メニューに、次で作成されたハイパーリンクを検索する機能がありません。 Ctrl+k。
ヘルパー列(列Zなど)で誤ったハイパーリンクの識別を自動化でき、次の式を使用できます。
=OR(ISNUMBER(SEARCH("Roaming", Link2Text($C2),1)),ISNUMBER(SEARCH("Roaming", Link2Text($D2),1)))
link2TextはUDFです
Function Link2Text(rng As Range)As String '非アクティブ化しないでください。 '列Zに「ローミング」を含むハイパーリンクを見つけます。
' Identify affected hyperlinks
If rng(1).Hyperlinks.Count Then
Link2Text = rng.Hyperlinks(1).Address
End If
End Function
エラーを修正する私のVBAは次のとおりです
Sub Replace_roaming()
'正しいシートSheets( "DIARY")を選択します。選択
Dim hl As Hyperlink
For Each hl In ActiveSheet.Hyperlinks
hl.Address = Replace(hl.Address, "AppData\Roaming\Microsoft\", "")
Next
For Each hl In ActiveSheet.Hyperlinks
hl.Address = Replace(hl.Address, "AppData\Roaming\", "")
Next
For Each hl In ActiveSheet.Hyperlinks
hl.Address = Replace(hl.Address, "../../AppData/Roaming/", "..\..\My documents\")
Next
For Each hl In ActiveSheet.Hyperlinks
hl.Address = Replace(hl.Address, "..\..\My documents\My documents\", "..\..\My documents\")
Next
Application.Run "Recalc_BT"
' Move down one active row to get off the heading
ActiveCell.Offset(1, 0).Select
' Check active row location
If ActiveCell.Row = 1 Then
ActiveCell.Offset(1, 0).Select
End If
' Recalc active row
ActiveCell.EntireRow.Calculate
' Notify
MsgBox "Replace roaming is now complete."
End Sub
また、定期的なバックアップを行い、自動回復のみに依存しない習慣を身に付けることもお勧めします。失敗した場合、最後の完全バックアップ以降何もありません。
1時間ごと、または新しいデータの重要なインポート後など、ワークシートは頻繁に脆弱なバックアップです。
次のショートカットにより、ワークシートが数秒でバックアップされます。 Ctrl+O、[ファイル名を強調表示]、 Ctrl+C、 Ctrl+V、 [ バツ ]。定期的なバックアップにより、昨夜のバックアップファイルから復元する必要なしに、特に他の人に依頼する必要がある場合は特に、最新のバックアップにすぐに移動できます。
パスとCSVファイル名を文字列変数に組み合わせて、.csvをドロップしてください。これはFileFormatによって処理されます。パスは、ドライブ文字またはサーバー名で始まる絶対パスでなければなりません:Dim strFullFileName as String
strFullFileName = "C:\My Folder\My_Sheet"
サーバー上の場合、次のようになります:strFullFileName = "\\ServerName\ShareName\My Folder\My_Sheet"
Substiture ServerNameをサーバー名に置き換え、ShareNameをネットワーク共有名に置き換えます。 \\data101\Accounting\My Folder\My_Sheet
ActiveWorkbook.SaveAs Filename:=strFullFileName,FileFormat:=xlCSVMSDOS, CreateBackup:=False