• ベストアンサー
  • 困ってます

エクセルと同じファイル名でcsvを作成するマクロ

エクセルからCSVファイルをYYMMDD付でマクロを使って 作ろうとしていますが拡張子の「.xls」がどうしても残ってしまいます。 例えば、「test.xls」が「test.xls070326.csv」のように。 これを「test070326.csv」とするにはどうしたらよいでしょう。 今のコードはつぎのようにしています。 Sub test1() Dim flname As Variant Dim wb As Workbook flname = ActiveWorkbook.Name + CStr(Format(Date, "yymmdd")) ActiveSheet.Copy ActiveSheet.SaveAs Filename:=flname, _ FileFormat:=xlCSV ActiveWindow.Close savechanges:=False ActiveWorkbook.Close End Sub これでもCSVとしては使えるのですが、気持ちがすっきりしません。 どなたか正解をお願いします。

共感・応援の気持ちを伝えよう!

  • 回答数3
  • 閲覧数279
  • ありがとう数3

質問者が選んだベストアンサー

  • ベストアンサー
  • 回答No.1
  • zap35
  • ベストアンサー率44% (1383/3079)

Sub test1() Dim flname As String  flname = Application.Substitute(ActiveWorkbook.Name, ".xls", "") _     & CStr(Format(Date, "yymmdd"))  ActiveSheet.Copy  ActiveSheet.SaveAs Filename:=flname, FileFormat:=xlCSV  ActiveWindow.Close savechanges:=False End Sub ではいかがでしょうか?  ただしパスを指定していませんので元のBookはディスクに保存されていることが前提です。

共感・感謝の気持ちを伝えよう!

質問者からのお礼

「Application.Substitute」とは初見です。 これで「.xls」を置き換えるのですね。 これですっきりしました。 すばやい解答ありがとうございました。

関連するQ&A

  • エクセルからCSVファイルに出力したい?

    エクセルのシートからマクロを使ってCSVファイルに出力したいです。 そこで調べたのですが、 http://oshiete1.goo.ne.jp/kotaeru.php3?q=2376607 こちらの質問で以下のようなコードが参考になりました。 Sub Macro1() Dim myBook As String myBook = ActiveWorkbook.FullName myBook = Left(myBook, Len(myBook) - 3) & "CSV" ActiveSheet.Copy ActiveWorkbook.SaveAs Filename:=myBook, FileFormat:=xlCSV ActiveWindow.Close False End Sub このコードではCSVのファイル名がエクセルシートのファイル名になってしまいます。 今回の質問ですが、CSVファイルを違う名前で保存するにはどのようにすればいいのでしょうか? (CSVファイルの名前は常にabc.csvで保存するものとします)

  • ExcelのマクロでCSVファイルを開くと遅いのですが

    ExcelのマクロでCSVファイルを開くと遅いのですが速く開く方法はありますか? 普通にファイル-開くに比べてかなり遅いです。 下記のVBAで記述してあります。 Workbooks.Open Filename:=fname ActiveWorkbook.SaveAs Filename:=fname, FileFormat:=xlCSV, _ CreateBackup:=False ActiveWorkbook.Close savechanges:=False

  • エクセルVBA【ワークシートのコピー】について

    以下のVBA記述で、とあるエクセルファイルのシートをCSV化しようとしております。記述の場合、すべてのワークシートが対象となっていますが、10個くらいあるWorkSheetの【sheets(8)】のみを対象としたいのですが、どのようにしたら良いのでしょうか? お手数ですがご教授下さい。 Sub test() Dim sh As Worksheet Dim fname As String Application.ScreenUpdating = False For Each sh In ActiveWorkbook.Worksheets fname = "C:\temp\" & sh.Name & ".csv" sh.Copy With ActiveWorkbook .SaveAs Filename:=fname, FileFormat:=xlCSV .Close savechanges:=False End With Next sh Application.ScreenUpdating = True End Sub

その他の回答 (2)

  • 回答No.3

InStr(ActiveWorkbook.Name, ".") - 1とは、Nameの中から「.」までの文字数を取得し、それから1を引いています。 Left(ActiveWorkbook.Name, で、Nameの左側からその数だけ文字をぬき出しています。

共感・感謝の気持ちを伝えよう!

質問者からのお礼

なるほどInStrとはSERCH関数のことですか。 (同じ機能なのに名前が違ったり、 Substituteは頭 に「Apprication.」が付いたり。 同一にして欲しいと思うのは私だけでしょうか) VBAのサンプルでは関数を見たこと無かったので ほとんど気にしていませんでしたがお蔭様で VBAでの使い方がわかりました。 お二人ともありがとうございました。

  • 回答No.2

Sub test1() Dim flname As Variant Dim wb As Workbook flname = Left(ActiveWorkbook.Name, InStr(ActiveWorkbook.Name, ".") - 1) & Format(Date, "yymmdd") & ".csv" ActiveSheet.Copy ActiveSheet.SaveAs Filename:=flname ActiveWindow.Close savechanges:=False ActiveWorkbook.Close End Sub でもできますね。

共感・感謝の気持ちを伝えよう!

質問者からのお礼

「InStr(ActiveWorkbook.Name, ".") - 1」とは Nameの中から拡張子の手前の「.」より左側の文字列を 使うという意味でしょうか。 私はNameの最後の4桁(拡張子部分)を消そうと思いましたが 桁数が変動するので無理と思いました。 いろいろやり方があるのですね。 これまた解答ありがとうございました。

関連するQ&A

  • 複数のCSVファイルを自動でエクセルに変換したい

    フォルダの中に、300近いCSVフォルダがあります。 ネットで探したマクロVBAでやってみたところ、一つのCSVファイルを選び、それをエクセルファイルに変換できました。 このマクロを使って、フォルダ内にあるすべてのCSVファイルを一気にエクセルに変換するには、どうしたらいいのでしょうか。 ご教授のほど、よろしくお願いいたします。 Sub CSVからXLSX() Dim varFileName As Variant varFileName = Application.GetOpenFilename(FileFilter:="CSVファイル(*.csv),*.csv", _ Title:="CSVファイルの選択") If varFileName = False Then Exit Sub End If Workbooks.Open Filename:=varFileName ActiveSheet.Cells.Copy ThisWorkbook.ActiveSheet.Cells ActiveWorkbook.Close SaveChanges:=False End Sub

  • Excelマクロ 空白セルを無視してCSV出力

    Excelのマクロについて質問します。 <sheet1>の内容をCSVに出力するマクロを使用しているのですが、 問題があって困っています。 <seet1>のA1~K30までは数式が入っていて、<sheet2>のA1~A30に 「OK」と表示されている場合、<sheet1>の対応した行に数値が表示されます。 「OK」以外の場合は、空白になるようにしてあります。 【sheet1】   A    B    C    D    E … 1 100  200  300  400  500 2 100  200  300  400  500 3 100  200  300  400  500 4 100  200  300  400  500 5 6 【sheet2】   A 1 OK 2 OK 3 OK 4 OK 5 6 <sheet1>をマクロでCSV出力する際に、「空白だけど数式が入っているセル」を 除外する方法を教えてください。 現在は「空白だけど数式が入っているセル」もCSV出力されてしまい、「,」が 連続で表示されるので、手動で「,」を削除しています。 ■今使用しているマクロは以下になるので、これに追記する形で改良できないでしょうか。 Sub CSV出力() Dim FileN As String FileN = Application.GetSaveAsFilename( _ InitialFileName:="book1.csv", _ FileFilter:="CSV ファイル (*.csv), *.csv") Sheets("sheet1").Copy ActiveWorkbook.SaveAs Filename:=FileN, FileFormat:=xlCSV ActiveWorkbook.Close Savechanges:=False End Sub よろしくお願いします。

  • エクセルファイル(book)のシートの内容をCSVファイルにおとしたい

    こんにちは。 VB初心者です。 実はVBではなく、Excel VBAで行なっているのですが。 ここに質問していいかもよく分かってないのですが。 プログラムの処理としては、あるBookのシートの内容を 別のCSVファイルとして生成したいのです。マクロを組んだのですが、一つ問題があって困っています。 問題: 生成したCSVファイルが一度Window上に表示されて (それはいいのですが、あとで閉じますから) 以下の確認メッセージがでてしまいます。 「outFile.csvはExcel97のファイル形式では、ありません。変更を保存しますか?」 要はプログラムがここで、一旦ユーザアクションを要求してしまうのです。 アクションなしに普通に終了させたいのですが。 マクロではなくVBだったらこんなことはならないのでしょうか? 初心なのでよく分かりません。 もしくはもっとほかの簡単なコードできるのでしょうか。 以下にコードを記述します。 Sub OutFile() Dim myWBpath As String myWBpath = ActiveWorkbook.Path Workbooks.Open FileName:=myWBpath & "\testData1.xls" Sheets("sheet1").Select ActiveWorkbook.SaveAs FileName:="C:\outFile.csv", _ FileFormat:=xlCSV, CreateBackup:=False ActiveWorkbook.Close End Sub

  • CSV保存マクロ 日付が逆になり困っています。

    マクロに詳しい方、お願いいたします。 エクセルのシートで2018/1/21とセルに記載したものを 下記マクロ(標準モジュールにコード記載)して、CSVで保存しています。 実行後CSVを開くと、21/1/2018になって逆になります。 調べてもわかりません。よろしくお願いします。 Sub Macro1() Application.DisplayAlerts = False main_f = ActiveWindow.Caption out_pass = ActiveWorkbook.Path & "\" Out_name = ActiveSheet.Name Sheets(Out_name).Select Sheets(Out_name).Copy ActiveWorkbook.SaveAs Filename:= _ out_pass & Out_name & ".csv", _ FileFormat:=xlCSV, CreateBackup:=False ActiveWindow.Close Application.DisplayAlerts = True End Sub

  • Excelのマクロで、セル内の文字をファイル名にしたい

    ”プロト.xls”というExcelファイルの中に、以下の動作をするマクロを作成したいのです。 (1)”C:\顧客\顧客納期連絡.xls”というExcelファイルを開き、  それを”C:\顧客\A.csv”という名前のcsvファイルにする。 (2)”C:\顧客\A.csv”を”xxxxxxxxxxxxxxxxxx”(※注1)という名前にしてコピーする。 ※注1:”xxxxxxxxxxxxxxxxxx”の部分は、”プロト.xls”ファイルのSheet”マスター”のセルD9から取得させる。 そのセルは、 C:\顧客\ABCDEF0215.csv と記述しています。 (3)コピー後、”C:\顧客\A.csv”を削除する。 ------------------------------------------------------------------- Sub 顧客納期連絡() ' ' 顧客納期連絡 Macro ' マクロ記録日 : 2010/2/15 ユーザー名 : xxxxxxx ' ' ChDir "C:\顧客" Workbooks.Open Filename:="C:\顧客\顧客納期連絡.xls" ActiveWorkbook.SaveAs Filename:="C:\顧客\A.csv", FileFormat:=xlCSV, _ CreateBackup:=False ActiveWorkbook.Save ActiveWindow.Close ActiveWorkbook.Save Dim fname1 As String Dim fname2 As String fname1 = "C:\顧客\A.csv" fname2 = Workbooks("プロト.xls"), Sheets("マスター"), Cells("D9") FileCopy fname1, fname2 Kill "C:\顧客\A.csv" End Sub ------------------------------------------------------------------- 上記のマクロを作成したのですが、FileCopyの行で、構文エラーか型に一致していない、 というエラーになりマクロ再生が停止します。 セルの内容をファイル名にしたいのですが、何か良い方法はございませんでしょうか? 私は超初心者なので、何卒宜しくお願い致します。

  • 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できないでしょうか?

  • 「変更を保存しますか?」と聞かれたくない。

    現在のファイルと同名のCSVファイルを作成したいのですが、 Sub CSV作成() Dim MyFileName As String MyFileName = ActiveWorkbook.FullName MyFileName = Left(MyFileName, Len(MyFileName) - 5) Workbooks.Add ActiveWorkbook.SaveAs Filename:=MyFileName & ".csv", FileFormat:=xlCSV ActiveWorkbook.Save ActiveWindow.Close End Sub をしたときに、「変更を保存しますか?」と聞かれます。 保存しますか?と聞かれても、無条件で保存したいし、そもそも変更してないのに、 なんで聞かれてるのかわかりません。 保存する方法を教えてください。ご回答よろしくお願いします。

  • エクセルで指定のシートを指定の文字コードで出力する方法

    はじめまして、エクセルのシートを文字コードを指定して出力したいのですが、どうやってよいかわからず困っております。 みなさんご教授いただければと思います。 ■やりたいこと 複数のシートがあるxlsファイルがあり、その中で特定のシートを UTF-16の文字コードで.txt出力したいです。 ■現在理解していること 【その1】 shift-jisで出力する方法は、以下のコードで行えることがわかって います。(以下のコードはCSV形式での出力ですが気にしないでください) ------------------------------------------ ''''''''''''''''''''''''''''''''' '指定したシートをcsv出力 ''''''''''''''''''''''''''''''''' Sub aaa_CSV出力() Dim Sh As Worksheet Dim strName As String Application.ScreenUpdating = False Application.DisplayAlerts = False '定型はここから Sheets("シート”).Activate 'csv出力したいシート名(=ファイル名) strName = ActiveWorkbook.Path & "\csv\" & ActiveSheet.Name & ".csv" 'csv出力する場所 'strName = "D:\csv_out\" & ActiveSheet.Name & ".csv" 'csv出力する場所 ActiveSheet.Copy With ActiveWorkbook .SaveAs Filename:=strName, FileFormat:=xlCSV .Close savechanges:=False End With End Sub ------------------------------------------ 【その2】 以下の参照設定を有効にして、以下の機能を使用しないと おそらく文字コードの指定は厳しいと、認識しています。 Microsoft ActiveX Data Object X.X Library 当方VBA自体は初心者で、サンプルのコードを書き換えて使っている程度です。 皆さんのお知恵を貸していただければと思います。 よろしくお願いいたします!!!

  • ExcelVBAでテキスト保存

    ExcelVBAを使って、ワークシートをテキストファイルに保存しようとしています。 CSV形式で保存するときは、   Sheets("test").Activate   ActiveSheet.SaveAs Filename:=ActiveSheet.Name & ".csv", _     FileFormat:=xlCSV, CreateBackup:=False でtest.csvに保存できますが、 単純にテキストファイルとして保存したいときに   Sheets("test").Activate   ActiveSheet.SaveAs Filename:=ActiveSheet.Name & ".txt", _     FileFormat:=xlText, CreateBackup:=False としても、実行時に下記のエラーになってしまいます。   実行時エラー '1004'   アプリケーション定義またはオブジェクト定義のエラーです。 どうしたらよいのでしょうか? また、CSVで保存した時も開いているファイルがtest.csvに変わってしまいますが、できれば、開いているファイルは元のファイルのままでシートだけを保存するにはSaveAsメソッドではなく、他のメソッドを使うのでしょうか? (hogehoge.xlsのtestシートを保存してもhogehoge.xlsが開いたままにしたい) 以上、宜しくお願いします。

  • (VBA)書式が変更されてしまいます

    ↓SaveAsで保存すると書式が変更されてしまいます。 ActiveWorkbook.SaveAs FileFormat:=xlCSV, _ CreateBackup:=False ActiveWorkbook.Close False ネットで↓の回避策を見つけたのですがうまくいきません。 **************************************************************** Sub CSV_Save() 'Sheet1をCSV形式で保存します。 With ActiveWorkbook.Sheets(1) 'A1:A10まで日付あるいは通貨設定のデータが入っているとします。 For Each rng In Range("A1:A10") 'テキスト文字列に変更します。 rng.Value = "'" & rng.Text Next rng End With ActiveWorkbook.SaveAs FileName:="C:\test.csv", FileFormat:=xlCSV End Sub **************************************************************** ご指導お願いします。