プロが教えるわが家の防犯対策術!

こんにちは。
当方マクロ初心者で、教本を片手にマクロを組んでいるレベルです。
宜しければご回答お願いします。

質問はタイトルにあるように、
「読み込んだcsvファイルの名前を別名保存のファイル名に使いたい」
ということです。

マクロ有効のエクセルファイル(abc.xlsm)に、csvファイル(123.csv)を取り込む
※GetOpenFilenameというマクロでcsvファイルを取り込んでいます(マクロボタンを設置)

取り込んだcsvデータで集計等の作業をする

作業が終わったマクロ有効エクセルファイル(abc.xlsm)を「別名をつけて保存」する
※この時、保存ダイアログボックスに読み込んだcsvファイルの名前が自動で付与される(123.xlsm)
ようにしたいです。

なお「別名をつけて保存」はエクセルファイル(abc.xlsm)上にマクロ実行用のボタンを設置して使用する予定です。
(ボタンで実行させるのはエクセルに不慣れな方も使用する為です)

説明が下手でやりたいことがうまく伝わっていないかもしれませんが、、、
よろしくご教授くださいませ。

A 回答 (3件)

1. とあるマクロ付きブック (仮に macro.xlsm) がある。

こいつは CSV を何らか処理するためのブックである。
2. とある csv ファイル (仮に 20150101.csv) がある。
3. macro.xlsm から 20150101.csv を開き、CSV に書かれているデータを読み取って macro.xlsm 自体のシート上に何らかの転記処理をする。
4. 処理が終わったら macro.xlsm 自身を別名保存する。 ファイル名は読み込み元の CSV ファイルにならって 20150101.xlsm にしたい。
5. 以後、次の CSV を処理する際も macro.xlsm を使って処理を行っていく。
という感じでしょうか。

CSV ファイルを開く際、CSV ファイルの名前を変数にとっておく。
→ 標準モジュールの public 変数にでも入れておく。
→ "名前を付けて保存" の処理と同じ標準モジュールにあるのなら public じゃなくて private な変数でも良い。
または
CSV ファイルを開く際に CSV ファイルを Workbook オブジェクトとして参照しているのなら、その変数の Name プロパティに格納されている。

以下のような変数に CSV ファイルのファイル名 (パスでも可能) を突っ込むと拡張子なしのファイル名を取得できます。
ex.) hoge.csv やら d:\test\hoge.csv やら \\server\aaa\hoge.csv → "hoge"

Function GetCsvBasename(aCsvFileName As String) As String
  Dim fso As Object
  Set fso = CreateObject("Scripting.FileSystemObject")
  
  Dim baseName As String
  baseName = fso.GetBaseName(aCsvFileName)
  
  GetCsvBasename = baseName
End Function


ただし xlsm ファイルを SaveAs で保存する際は FileFormat 引数に "xlOpenXMLWorkbookMacroEnabled" を指定しなくてはなりません。。

ThisWorkbook.SaveAs "csv ファイル名", xlOpenXMLWorkbookMacroEnabled
    • good
    • 0
この回答へのお礼

ありがとうございました!

お礼日時:2015/09/18 13:36

こんにちは。



>説明が下手でやりたいことがうまく伝わっていないかもしれませんが、、、
というよりも、やはり内容的には製作依頼になってしまいますね。
ただ、誰が作ったものであれ、他人の作ったものですと「なくて七癖」で違いが出てきて、「これは何?」とか、不本意なものがあるかもしれません。一応、事前に、ご知らせさせていただます。

・以下のマクロの特徴
拡張子の選択は、一応、ご要望通り、'xlsm' は選択できますが、もしない場合はそうではない場合は、標準の 'xlsx' に戻ってしまいます。基本的には、'xlsx' で良いのではないかと思います。

自動化のため、最初のファイルの選択(GetOpenFileName)以外の、保存時のダイアログ型はやめました。
>csvファイルの名前が自動で付与される(123.xlsm)
もし同名のファイルがあった場合は、自動的に枝番が付きます。言い換えると、既存のファイルの上書きをしないということにしました。

>マクロ有効のエクセルファイル(abc.xlsm)に、csvファイル(123.csv)を取り込む
これ自体は変わりませんが、取り込んだCSVファイルは、残す・残さないの選択は可能です。

 '.Copy 'シートを残す場合
 .Move '追加したシートを分離

現行では、分離-残さないという選定になっています。

'//
Sub CSVImport()
 Dim fn As Variant
 Dim outFn As Variant
 Dim fNum As Integer
 Dim i As Long, buf As Variant
 Dim TextLine As String
 Dim myArray
 Dim lngCount As Long
 Dim BaseFn As String, orgBaseFn As String '基幹ファイル名
 Dim strFilter As String
 Dim myPath As String
 Dim fFormat As Integer
 
 '拡張子の選択
 '拡張子の選択
 Dim EXTE As String: EXTE = ".xlsm"
 If StrComp(EXTE, ".xlsm", vbTextCompare) = 0 Then
  fFormat = xlOpenXMLWorkbookMacroEnabled '52
 Else
  fFormat = xlOpenXMLWorkbook '51
  EXTE = ".xlsx"
 End If

 On Error GoTo ErrHandler
 'ファイル選択ダイアログ
 fn = Application.GetOpenFilename("CSVファイル(*.csv),*.csv", Title:="ファイル選択")
 If VarType(fn) = vbBoolean Then Exit Sub
 'ベースファイル名を取得
 myPath = Left(fn, InStrRev(fn, "\"))
 outFn = Dir(fn)
 BaseFn = Left(outFn, InStrRev(outFn, ".") - 1)
 orgBaseFn = BaseFn '変更用のために確保
 'ファイル・テキストインポート
 fNum = FreeFile()
 Open fn For Input As #fNum
 With ActiveWorkbook
  .Worksheets.Add After:=Worksheets(Worksheets.Count)
 End With
 
 With ActiveSheet
  Application.ScreenUpdating = False
  Do While Not EOF(fNum)
   Line Input #fNum, TextLine
   If Len(TextLine) > 1 Then
    lngCount = lngCount + 1
    myArray = Split(TextLine, ",") 'デリミタは、「,」
    .Cells(lngCount, 1).Resize(, UBound(myArray) + 1).Value = myArray
   End If
  Loop
  Close #fNum
  Application.ScreenUpdating = True
  '.Copy 'シートを残す場合
  .Move '追加したシートを分離
 End With
 With ActiveWorkbook
  '出力ファイル名
  'ファイル名の重複を避ける
  buf = Dir(myPath & BaseFn & EXTE)
  Do Until buf = ""
   i = i + 1
   BaseFn = orgBaseFn & "_" & CStr(i)
   buf = Dir(myPath & BaseFn & EXTE)
  Loop
  .SaveAs myPath & BaseFn, fFormat
  .Close False
 End With
 MsgBox BaseFn & EXTE & "の保存終了", vbInformation
 Exit Sub
ErrHandler:
 MsgBox Err.Number & ": " & Err.Description
End Sub
'///
    • good
    • 0

やりたいことが見えない部分があります。


取り込んだCSV・・・は
abc.xlsmのシートにコピペしているの?
今のコードは公開できないのかな。
ということでファイル名の取り出しだけです。

Sub sample()
Dim FilePath As String, FileName As String, v As Variant, i As Integer

FilePath = Application.GetOpenFilename("CSV Files (*.csv), *.csv")
v = Split(FilePath, "\")
For i = LBound(v) To UBound(v) '以下3行イミディエイトウィンドウでの確認用
Debug.Print i & "__" & v(i)
Next

FileName = v(UBound(v)) '拡張子を含んだファイル名
Debug.Print "あり", FileName

FileName = Left(v(UBound(v)), InStrRev(v(UBound(v)), ".") - 1) '拡張子含まず
Debug.Print "なし", FileName
End Sub
    • good
    • 0

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!