[[20141212160129]]　『複数のテキストファイルを同時にxlsx形式に変換し』（筋）　ページの最後に飛ぶ

『複数のテキストファイルを同時にxlsx形式に変換し、保存までしたい』（筋）

こんにちは。
今回、テキストファイルをカンマ、スペースで区切り、エクセルファイルとして保存するマクロを作成しました。
以下にそのマクロを示します。
↓
↓
Sub test()

    Dim File種類, Prompt, Item As String
    Dim FileNamePath As Variant
    Dim NewWorkSheet As Worksheet
    Dim i As Single
    Dim title As String

'テキストファイル読み込み

    File種類 = "テキスト ﾌｧｲﾙ (*.txt),*.txt"
    Prompt = "csv ファイルを選択してください"
    FileNamePath = SelectFileNamePath(File種類, Prompt)

    If FileNamePath = False Then
        End
    End If

    Workbooks.OpenText FileName:=FileNamePath, _
                       DataType:=xlDelimited, Comma:=True, Space:=True, _
                       ConsecutiveDelimiter:=True, TextQualifier:=xlTextQualifierDoubleQuote, trailingMinusNumbers:=True

'名前を付けて保存

    i = ActiveWorksheets.Range("C32").value
    title = CStr(i)

    ActiveWorkbook.SaveAs FileName:=title + "." + "xlsx", FileFormat:=xlOpenXMLWorkbook

End Sub

Function SelectFileNamePath(File種類, Prompt) As Variant

  SelectFileNamePath = Application.GetOpenFilename(File種類, , Prompt)
End Function

このマクロを実行すると、1つずつのテキストファイルについてのみしか実行できないのですが、複数のテキストファイルに対して一気に実行することは可能なのでしょうか？

＜使用 Excel：Excel2013、使用 OS：Windows7 ＞

とりあえず、ダイアログ表示箇所を以下に変更。

  SelectFileNamePath = Application.GetOpenFilename(File種類, , Prompt, MultiSelect:=True)

これで複数ファイル選択可能になるので、UBound(FileNamePath)個のファイル名分、ループさせましょう。
（???） 2014/12/12(金) 17:03

ありがとうございます。
ご指摘いただいた点を直すことにより、複数選択することはできたのですが、
for～next文で繰り返し操作を行ったところ、11行目（If FileNamePath = False Then）でエラーが生じてしまいました。
これはどういうことなのでしょうか？
（筋） 2014/12/12(金) 18:03

 横から失礼します。

 >for～next文で繰り返し操作を行ったところ、11行目（If FileNamePath = False Then）でエラーが生じてしまいました。

 どういうコードになりましたか？

 If IsArray(FileNamePath) = False

 としたらどうなりますか？
（カリーニン） 2014/12/12(金) 20:20

カリーニン様

回答ありがとうございます。

for～next文を用いて自分で作成したのは以下のようになりました。
↓
↓
Sub test()

    Dim File種類, Prompt, Item As String
    Dim FileNamePath As Variant
    Dim NewWorkSheet As Worksheet
    Dim i As Single
    Dim title As String
　　Dim j as Integar

'テキストファイル読み込み

For j = 1 to 15

    File種類 = "テキスト ﾌｧｲﾙ (*.txt),*.txt"
    Prompt = "csv ファイルを選択してください"
    FileNamePath = SelectFileNamePath(File種類, Prompt)

    If FileNamePath = False Then
        End
    End If

    Workbooks.OpenText FileName:=FileNamePath, _
                       DataType:=xlDelimited, Comma:=True, Space:=True, _
                       ConsecutiveDelimiter:=True, TextQualifier:=xlTextQualifierDoubleQuote, trailingMinusNumbers:=True

'名前を付けて保存

    i = ActiveWorksheets.Range("C32").value
    title = CStr(i)

    ActiveWorkbook.SaveAs FileName:=title + "." + "xlsx", FileFormat:=xlOpenXMLWorkbook

End Sub

Function SelectFileNamePath(File種類, Prompt) As Variant

  SelectFileNamePath = Application.GetOpenFilename(File種類, , Prompt, MultiSelect:=True)
End Function

また、ご指摘いただいたように11行目をIf IsArray(FileNamePath) = Falseを変えてみましたが上手くいかず、このときは14行目
Workbooks.OpenText FileName:=FileNamePath, _

                       DataType:=xlDelimited, Comma:=True, Space:=True, _
                       ConsecutiveDelimiter:=True, TextQualifier:=xlTextQualifierDoubleQuote, trailingMinusNumbers:=True
でエラーが生じてしまいました、、、

（筋） 2014/12/14(日) 17:52

 参考HPです。(IsArray)もここで勉強しました。

http://officetanaka.net/excel/vba/file/file02.htm

 「Sample7」が複数選択の場合の各ファイルの取得方法です。
（カリーニン） 2014/12/14(日) 20:13

Integer のスペルが違います。また、OpenTextに得られたファイル名ををまとめて指定してはいけません。
j のループがダイアログ表示の外にあるので、これだと15回、ファイル選択してOKを繰り返すことになりますよ？

あと、読み込むファイルは複数なのに、保存するファイルが1つというのはどういう事でしょう？
とりあえず、元のファイル名の拡張子を変えて、それぞれ保存する例。

 Sub test()
    Dim FileNamePath As Variant
    Dim i As Long
    Dim cw As String

    'テキストファイル読み込み
    FileNamePath = Application.GetOpenFilename("テキスト ﾌｧｲﾙ (*.txt),*.txt", , "csv ファイルを選択してください", MultiSelect:=True)
    If IsArray(FileNamePath) = False Then
        Exit Sub
    End If

    For i = 1 To UBound(FileNamePath)
        Workbooks.OpenText Filename:=FileNamePath(i), _
            DataType:=xlDelimited, Comma:=True, Space:=True, _
            ConsecutiveDelimiter:=True, TextQualifier:=xlTextQualifierDoubleQuote, trailingMinusNumbers:=True
        cw = Left(FileNamePath(i), InStrRev(FileNamePath(i), ".")) & "xlsx"
        ActiveWorkbook.SaveAs Filename:=cw, FileFormat:=xlOpenXMLWorkbook
        ActiveWorkbook.Close
    Next i
 End Sub
（???） 2014/12/15(月) 09:52

解決いたしました。
カリーニン様、???様、ありがとうございました。
（筋） 2014/12/15(月) 20:51

コメント返信：

[ 一覧(最新更新順) ]

[[20141212160129]] 『複数のテキストファイルを同時にxlsx形式に変換し』（筋） ページの最後に飛ぶ

[[20141212160129]]　『複数のテキストファイルを同時にxlsx形式に変換し』（筋）　ページの最後に飛ぶ