ActiveWorkBook VBA

質問

Sub test()
Dim myCSV As String
Dim Fname As Variant
Dim Aname As String
Dim Fullp As String
Application.ScreenUpdating = False
Fullp = ActiveWorkbook.FullName
Pos = InStrRev(Fullp, "\")
Fname = Left(Fullp, Pos)

myCSV = Dir(Fname & "*.csv")
Do Until myCSV = ""
Workbooks.Open Fname & myCSV

Aname = Left(Fullp, InStr(1, Fullp, ".") - 1)
ActiveWorkbook.SaveAs filename:=Aname & ".xls", FileFormat:=xlExcel9795
ActiveWorkbook.Close
myCSV = Dir()
Loop

Kill Fname & "*.csv"
End Sub

あるフォルダにあるcsvファイルをxlsで保存したいと思いましたが、アクティブになるBOOKがバラバラ？
で、うまくいきません。csvファイルを開いたときに
そのファイルがアクティブになり、うまくloopできないでしょうか？

回答No.1

Wendy02 · ベストアンサー

こんばんは。

＞あるフォルダにあるcsvファイルをxlsで保存したいと思いましたが、アクティブになるBOOKがバラバラ？

マクロを入れた元のブックにあわせた統一した枝番でもつけた名前を付けるつもりなのですか？コードの意味が良く分りません。いくらスクリプト言語でも、ActiveWorkbook が変わって、次のコードを見失うことはありません。

＞Aname = Left(Fullp, InStr(1, Fullp, ".") - 1)
　　↑
マクロで動かしているアクティブブックのファイル名
＞ActiveWorkbook.SaveAs filename:=Aname & ".xls", FileFormat:=xlExcel9795
　Aname =アクティブブックのファイル名 で保存？

それと、ファイルの削除は、その都度行ったほうがよいと思います。特に理由はありません。

サンプルとして作ってみました。

Sub test2()
　 Dim myCSV As String
　 Dim FilePath As String
　 Dim BaseName As String
　 Application.ScreenUpdating = False

　 FilePath = ActiveWorkbook.Path & "\"
　 myCSV = Dir(FilePath & "*.csv")

　 On Error Resume Next
　 Do Until myCSV = ""
　　　BaseName = Mid$(myCSV, 1, InStrRev(myCSV, ".") - 1)
　　　Workbooks.Open FilePath & myCSV
　　　ActiveWorkbook.SaveAs Filename:=BaseName & ".xls", FileFormat:=xlExcel9795
　　　ActiveWorkbook.Close
　　　Kill FilePath & myCSV
　　　myCSV = Dir()
　 Loop
　 On Error Goto 0

End Sub

お礼

ありがとうございます(^^♪
お昼からずっとやっていたので助かりました。