エクセルマクロ xlsm拡張子からcsv拡張子への変換方法

ファイル内の沢山のマクロ有効ファイルを自動でxlsm形式からcsv形式に変換するプログラムを作成したいと思い、ネツト等で調べ下記のマクロを組みましたが、うまく作動しません。
どうすればできるようになるかご存知の方がいれば教えていただけないでしょうか？

Sub ボタン2_Click()
Dim myObj As Object
Dim myDir As String
Dim myFileName As String
Dim myFileList As String
Dim myFileCount As Long
Dim wb As Workbook
'フォルダ選択ダイアログの表示
Set myObj = CreateObject("Shell.Application"). _
BrowseForFolder(0, "フォルダを選択してください", 0)
If myObj Is Nothing Then Exit Sub
myDir = myObj.Items.Item.Path
If Right(myDir, 1) <> "\" Then myDir = myDir & "\"
'フォルダ内のExcelファイルを確認
myFileName = Dir(myDir & "*.xlsm")
Do While myFileName <> ""
If myFileName <> ThisWorkbook.Name Then
myFileList = myFileList & Chr(13) & myFileName
myFileCount = myFileCount + 1
End If
myFileName = Dir()
Loop
If myFileCount = 0 Then
MsgBox "ファイルは見つかりませんでした。マクロを終了します。", 48
Exit Sub
ElseIf vbNo = MsgBox(myFileCount & " 個の .xlsm ファイルが見つかりました。マクロを実行しますか？" _
& Chr(13) & myFileList, 4, "ファイル確認") Then
MsgBox "キャンセルしました。"
Exit Sub
End If
'CSV処理
myFileName = Dir(myDir & "*.xlsm")
Do While myFileName <> ""
Application.DisplayAlerts = False
Application.ScreenUpdating = False
If myFileName <> ThisWorkbook.Name Then
Workbooks.Open (myDir & myFileName)
Workbooks(myFileName).Activate

ActiveWorkbook.SaveAs Filename:=myDir & Left(myFileName, Len(myFileName) - 4) & "csv", _
FileFormat:=xlCSV, CreateBackup:=False
ActiveWorkbook.Close
↑上記３行でエラー発生

End If
myFileName = Dir()
Loop
Application.DisplayAlerts = True
Application.ScreenUpdating = True
MsgBox "完了しました。"


End Sub

No.3 回答者： WindFaller 回答日時： 2016/04/22 09:41

#1,#2で書いた者です。

お返事が付かないようですが、#2の考え方というのは、
保存できないものは、回避して、名前だけ記録していこうという趣旨です。

それで、そのファイルの原因が分かったら、それに対応する処置を取ったらどうかという考え方です。全部がダメなら、そこは保存できない場所っていうことになりますが。

主な原因は、ロードとセーブ(SaveAs)でのファイル名の取り扱いに違いがあるということです。

No.2 回答者： WindFaller 回答日時： 2016/04/20 18:23

>エラーの内容は「実行時エラー'1004' save as メソッドは失敗しました。

_‘work bookオブジェクト‘」です。ちなみに私のエクセルは2010ですが
>WindFaller様のエクセルバージョンを教えていただけないでしょうか？

Excel2010 で同じです。ただ、Excelのバージョンの問題ではありませんね。

>SaveAs メソッドでエラー

CSV 以下をこのようにしてみてください。たぶん、保存ができないようになっているのだと思います。ただ、このワザは、実務以外には使われません。実務では、もうひとつ、
Application.Calculation = xlCalculationManual
　　以下に同じように入れる
Application.Calculation = xlCalculationAutomatic

'//
　　'CSV処理
　Dim reco_err　　'上に持って行っても可
　　myFileName = Dir(myDir & "*.xlsm")
　　Do While myFileName <> ""
　　　　Application.DisplayAlerts = False
　　　　Application.ScreenUpdating = False
　　　　Application.EnableEvents = False
　　　　On Error GoTo ErrHandler
　　　　If myFileName <> ThisWorkbook.Name Then
　　　　　　With Workbooks.Open(myDir & myFileName)
　　　　　　　　.SaveAs Filename:=myDir & Left(myFileName, Len(myFileName) - 4) & "csv", FileFormat:=xlCSV
　　　　　　　　.Close False
　　　　　　End With
　　　　End If
errNext:
　　　　myFileName = Dir()
　　Loop
　　Application.DisplayAlerts = True
　　Application.ScreenUpdating = True
　　Application.EnableEvents = True
　　MsgBox "完了しました。"
　　If Len(reco_err) > 2 Then
　　　　MsgBox reco_err
　　End If
　　Exit Sub
ErrHandler:
　　If Err.Number <> 0 Then
　　　　reco_err = reco_err & vbCrLf & Err.Number & ": " & myFileName
　　　　GoTo errNext
　　End If
End Sub

No.1 回答者： WindFaller 回答日時： 2016/04/20 13:47

こんにちは。

試してみましたが、特にエラーはありませんでした。
別の要因かもしれませんね。

ただし、保存のマクロの部分は、以下のように書き換えました。
特に、Activate する必要はありません。

　　 Application.DisplayAlerts = False
　　　　Application.ScreenUpdating = False
　　　　If myFileName <> ThisWorkbook.Name Then
　　　　 With Workbooks.Open(myDir & myFileName)
　　　　　　.SaveAs Filename:=myDir & Left(myFileName, Len(myFileName) - 4) & "csv", _
　　　　　　FileFormat:=xlCSV, CreateBackup:=False
　　　　　　.Close False
　　　　　　End With
　　　　End If
　　　　myFileName = Dir()
　　Loop

この回答へのお礼

回答ありがとうございます。ためしてみましたがやはりエラーがでます。
エラーの内容は「実行時エラー'1004' save as メソッドは失敗しました。_‘work bookオブジェクト‘」です。ちなみに私のエクセルは2010ですが
WindFaller様のエクセルバージョンを教えていただけないでしょうか？

お礼日時：2016/04/20 17:01