複数のtxtファイルをエクセルに貼りつける方法
- 特定のフォルダ内に複数のフォルダがあり、その中の各フォルダには、txtファイルが複数あります。VBAを使ってエクセルのA列にフォルダ名、B列にtxtファイル名、C列にはtxtファイルの内容を入れたいです。
- VBAを使って特定のフォルダ内のtxtファイルの内容をエクセルに貼りつける方法を教えてください。
- 特定のフォルダ内にある複数のtxtファイルの内容を、VBAを使ってエクセルに自動で貼りつける方法を知りたいです。
- ベストアンサー
複数のtｘtファイルをエクセルに貼りつける方法 ２
前回質問した者です。 http://okwave.jp/qa/q7062908.html ある特定のフォルダ内に複数のフォルダがあり、その中の各フォルダには、txtファイルが複数あります。 ＶＢＡを使ってエクセルのＡ列にフォルダ名、Ｂ列にtxtファイル名、C列にはtxtファイルの内容を入れたいです。（今はコピペを手動で行っています） フォルダＡ ↓ フォルダ１、フォルダ２、フォルダ３、・・・・ ↓ 各フォルダにはtxtファイル（改行あり） ＶＢＡは解らないのですが、自分なりに検索してみて、以下のコードを見つけました。 しかし、以下の場合はＡ列にtxtファイルの内容しか入らず、また、特定のフォルダのみしか反映されません。 そこで、フォルダＡのパスだけを指定して、Ａ列にフォルダ名、Ｂ列にtxtファイル名、C列にはtxtファイルの内容を入れるにはどうすればいいのでしょうか？ Sub Macro() Dim fso As Object Set fso = CreateObject("Scripting.FileSystemObject") Dim FolderPath As String 'ここのアドレスをファイルが格納されているフォルダのパスに変えてください FolderPath = "H:\Documents and Settings\asano\デスクトップ\TEST" Dim myFile As Object Dim i As Long i = 1 For Each myFile In fso.GetFolder(FolderPath).Files Cells(i, 1).Value = fso.OpenTextFile(myFile.Path).ReadAll() i = i + 1 Next End Sub
- siraku
- お礼率54% (276/508)
- オフィス系ソフト
- 回答数2
- ありがとう数1
- みんなの回答 （2）
- 専門家の回答
質問者が選んだベストアンサー
フォルダAの下のサブフォルダが1階層だけ（子フォルダまで）なら、「再帰」で全てのサブフォルダを舐める事無く、For Each を二重にするだけで済みます。 i = 1 の下を次の様に書き換えて見てください。 Dim myFolder As Object For Each myFolder In fso.GetFolder(FolderPath).SubFolders For Each myFile In fso.GetFolder(myFolder).Files Cells(i, 1).Value = myFolder Cells(i, 2).Value = myFile.Name Cells(i, 3).Value = fso.OpenTextFile(myFile.Path).ReadAll() i = i + 1 Next Next テキストファイル以外が入っていた時などの処理は元のコードでも考慮されていないので省略しています。また、前回の質問は見ていませんので何か別な条件があっても考慮していません。あしからず。
その他の回答 (1)
- 0909union
- ベストアンサー率39% (325/818)
プログラミングのロジックの学習で最初にならうのが、 ”再帰” と言う手法です。これを学べばいいだけです。 ＞ある特定のフォルダ内に複数のフォルダがあり、その中の各フォルダには、txtファイルが複数 最初のフォルダーを指定すれば、「再帰的にループ」を繰り返すことで、全てのドライブの全てのフォルダーに在るファイルがリストされます。そのファイルに対してのパス名を取得して、処理に渡せば言いだけです。 http://search.yahoo.co.jp/search?b=1&n=10&ei=UTF-8&fr=ie8sc&p=VBA+sample+%E5%86%8D%E5%B8%B0 （再帰検索リスト） http://itpro.nikkeibp.co.jp/article/COLUMN/20060206/228661/ （上記から適当と思われる再帰ロジック説明） さらに、有効なドライブの取得方法 http://search.yahoo.co.jp/search?p=VBA+sample+%E6%9C%89%E5%8A%B9%E3%83%89%E3%83%A9%E3%82%A4%E3%83%96%E5%8F%96%E5%BE%97&aq=-1&oq=&ei=UTF-8&fr=ie8sc&n=10&x=wrt （検索リスト） このドライブレターを再帰ループの先頭で指定すれば、対象となるドライブのリストが得られる。もちろん最初から特定ドライブがあれば、それを指定するだけ。 これは、基本的には”Scripting.FileSystemObject”のクラス（COM）を使用するか、シェル（エクスプローラ）”Shell.Application”のクラス（COM） http://msdn.microsoft.com/ja-jp/library/cc409798.aspx http://search.yahoo.co.jp/search?p=Shell.Application&aq=-1&oq=&ei=UTF-8&fr=ie8sc&n=10&x=wrt を使用すると今後の展開力に強くなる。 どれを使っても達成できるので、まあ自由にやってください。 最後にファイルのオープンの仕方と、エクセルオブジェクトのデータバインド（セルへのデータ流し込み）の仕方をそれぞれの検索するだけ。 それを for while http://search.yahoo.co.jp/search?b=1&n=10&ei=UTF-8&fr=ie8sc&p=VBA+%E6%9B%B8%E5%BC%8F%E3%80%80%E3%83%AB%E3%83%BC%E3%83%97 などのループの中に入れるだけ。 それと、VBAの書式では、クラス定義又はサブルーチンの作成の仕方を取得する必要がある。 http://search.yahoo.co.jp/search?p=VBA+%E6%9B%B8%E5%BC%8F+%E3%82%B5%E3%83%96%E3%83%AB%E3%83%BC%E3%83%81%E3%83%B3&aq=-1&oq=&ei=UTF-8&fr=ie8sc&n=10&x=wrt さて、これらを自分でチョイスしてできなようでは、自分でスクリプトを作るのをあきらめてください。
関連するQ&A
- テキストファイルをエクセルに移すマクロのことで？
以前、複数のテキストファイルをエクセルに移すマクロを教えてもらったのですが、 以下マクロですと、フォルダのパスを指定しないといけません。 今回教えてもらいたいのは、フォルダのパスを指定しなくてもよい方法です。 どういう事かと言うと、仮にディスクトップにフォルダがあるとします。 そのフォルダの中には、マクロが入っているエクセルシートとテキストが入っているフォルダです。 つまり、そのフォルダ内だけで、処理をしたいと考えています。 また、フォルダ名は、その時によって異なります。 今までは、以下の方法を使っていたのですが、ちょっと使いにくいと感じています。 申し訳ありませんが、どなたか教えていただけないでしょうか？ Sub Macro() Dim fso As Object Set fso = CreateObject("Scripting.FileSystemObject") Dim FolderPath As String 'ここのアドレスをファイルが格納されているフォルダのパスに変えてください FolderPath = "C:\Users\・・・" Dim myFile As Object Dim i As Long i = 2 Dim myFolder As Object For Each myFolder In fso.GetFolder(FolderPath).SubFolders For Each myFile In fso.GetFolder(myFolder).Files Cells(i, 4).Value = myFolder Cells(i, 1).Value = myFile.Name Cells(i, 7).Value = fso.OpenTextFile(myFile.Path).ReadAll() i = i + 1 Next Next End Sub Private Sub CommandButton1_Click() End Sub
- ベストアンサー
- オフィス系ソフト
- マクロのことで再度質問です。
すいません、先ほど質問した者です。 http://okwave.jp/qa/q7357905.html 以下のマクロを試すと・・ Ａのセルに「ファイル名.txt」 Ｂのセルに「C:\Users\～￥フォルダ名」 となります。 この「.txt」と「C:\Users\～￥」は表示させたくありません。 自分でもいじってみたのですが、できませんでした。 表示させないようにするにはどうすればいいでしょうか？ 度々の質問で恐縮ですが、よろしくお願いします。 Sub Macro() Dim fso As Object Set fso = CreateObject("Scripting.FileSystemObject") Dim FolderPath As String FolderPath = ThisWorkbook.Path Dim myFile As Object Dim i As Long i = 2 Dim myFolder As Object For Each myFolder In fso.GetFolder(FolderPath).SubFolders For Each myFile In fso.GetFolder(myFolder).Files Cells(i, 4).Value = myFolder Cells(i, 1).Value = myFile.Name Cells(i, 7).Value = fso.OpenTextFile(myFile.Path).ReadAll() i = i + 1 Next Next End Sub Private Sub CommandButton1_Click() End Sub
- ベストアンサー
- オフィス系ソフト
- FSOを使いサブフォルダのファイル操作
同じ階層のサブフォルダにxlsm入るが入っており、VBAによりモジュールを解放しようと試みています。 まずは、FSOを使ってサブフォルダにアクセスしようとしましたが、下から6行目でエラー（424 オブジェクトが必要です）が出てしまい、解決できませんので、ご教示いただけないでしょうか？ よろしくお願いします Sub DeleteMain() With Application.FileDialog(msoFileDialogFolderPicker) If Not .Show Then Exit Sub Call DeleteSub(folderPath:=.SelectedItems(1)) End With End Sub Sub DeleteSub(folderPath As String, Optional mycount As Long = 0) Dim fso As Object, myFolders As Object, myfile As Object Set fso = CreateObject("Scripting.FileSystemObject") Set myFolders = fso.GetFolder(folderPath).SubFolders For Each myfile In fso.GetFolder(folderPath).Files mycount = mycount + 1 ' Cells(mycount, 1) = myfile.Path Debug.Print myfile.Path Next For Each myFolders In fso.GetFolder(folder.Path).SubFolders Call DeleteSub(myFolder.Path, mycount) Next Set fso = Nothing Set myFolders = Nothing End Sub
- ベストアンサー
- Excel（エクセル）
- VBA フォルダー内のファイル名・サイズの書き出し
教えて下さい。 フォルダー名をダイアログを表示して選択する場合は、下記のコードを利用します。 Sub Test() Dim folderPath As Variant With Application.FileDialog(msoFileDialogFolderPicker) .Show folderPath = .SelectedItems(1) End With このfolderPathを利用して フォルダー内のファイル名（B列)とサイズ（C列）をセルに書き出したいのです。 （ただし、ファイルサイズが2GBを超えるファイルも存在します。） -------------------------------------------------------------------- 下記が参考なりそうですが、フォルダー名の取得の仕方が 上記コードと異なるので思考が停止しています。 'Excel VBAでフォルダ内のファイルリストを作成 Private Sub ExGetFileList(strPath As String) Dim i As Long Dim tSfo As Object Dim tGf As Object Dim tFi As Object Dim tSub As Object Set tSfo = CreateObject("Scripting.FileSystemObject") Set tGf = tSfo.GetFolder(strPath) i = 4 For Each tFi In tGf.Files 'ファイル名 Cells(i, 2) = tFi.Name 'ファイルサイズ KByte Cells(i, 6) = Int(tFi.Size / 1024) i = i + 1 Next End Sub Private Sub CommandButton1_Click() ExGetFileList "e:\MyDir" End Sub どのように整合させれば良いですか ？
- ベストアンサー
- Excel（エクセル）
- 複数テキストファイルをエクセルで開く
度々の質問申し訳ございません。 複数のテキストファイルが入ったフォルダ内のすべてのテキストデータをエクセルの1シートで開きたいです。 他の方の同じような質問の御回答に以下のようなマクロが有りました。 Sub macro1() Dim myPath As String Dim myFile As String Dim n, c, s '初期化 myPath = ThisWorkbook.Path & "\" myFile = Dir(myPath & "*.txt") '受入準備 On Error Resume Next Worksheets.Add before:=Worksheets(1) ActiveSheet.Name = Format(Date, "yyyymmdd") On Error GoTo 0 'ファイルの巡回 Do Until myFile = "" n = n + 1 Cells(n, "A") = myFile 'データの読み出し Open myPath & myFile For Input As #1 c = 1 Do Until EOF(1) Line Input #1, s c = c + 1 Cells(n, c) = s Loop Close #1 myFile = Dir() Loop End Sub これを利用させていただいて、テキストファイルを開いたのですが、こちらのマクロですとテキストデータの1列目しか開く事が出来ません。（図参照） 1列目2列目共に開くには何処を変更すれば良いですか？ マクロはまったく理解できないので、何卒宜しくお願い致します。 また、できればエクセルの横方向に開くのではなく、縦方向に開けるようにして頂けると非常にありがたいです。 何卒宜しくお願い致します。
- ベストアンサー
- オフィス系ソフト
- 返ってくる値が違う
VBAでフォルダの中のファイルの個数を取得するコードなのですが Sub test1() Dim i As Long, buf, Path As String Path = ActiveWorkbook.Path & "\" buf = Dir(Path & "*.*") Do While buf <> "" i = i + 1 buf = Dir() Loop MsgBox "「" & ActiveWorkbook.Path & "」には、全部で" & i & "個のファイルがあります。" End Sub Sub test2() Dim Path As String Dim i As Long, FSO As Object, f As Object Path = ActiveWorkbook.Path & "\" Set FSO = CreateObject("Scripting.FileSystemObject") MsgBox "「" & ActiveWorkbook.Path & "」には、全部で" & FSO.GetFolder(Path).Files.Count & "個のファイルがあります。" Set FSO = Nothing End Sub Test1とtest2では返ってくる値が違うのですが なぜでしょうか？ Test2はフォルダの個数も取得されてるのですか？
- 締切済み
- Visual Basic
- A列の値を元にフォルダを作成するVBAの質問です
A列の値を元にフォルダを作成するVBAで 富士通の緑の本を参考にして作ってみたのですが、 うまく動作しません。 1.Sub フォルダ作成() 2. 3. Dim MyFSO As New FileSystemObject 4. Dim Folderpath As String 5. Dim i As Integer 6. 7. i = 1 8. 9. Do While Cells(i, 1).Value <> "" 10. 11. Folderpath = ThisWorkbook & "\Cells(i, 1).value" 12. 13. MyFSO.CreateFolder Path:=Folderpath 14. 15. i = i + 1 16. 17. Loop 18. 19.Set MyFSO = Nothing 20. 21.End Sub 目的の動作は 今のワークブックのある場所にSheet1のA列の1～データがなくなるまで、 そのセルの値のフォルダを作成する。 になります。 よろしくお願いします。
- ベストアンサー
- Visual Basic
- 特定のワークシートcsvファイル書き出しほか
エクセルブックの中身が、 1番目 graphシート 2番目から19番目 ワークシート で構成されているエクセルファイルが100個 AAAというフォルダに入っています。 それぞれのエクセルブックにあるシートを、ブックのファイル名にしたフォルダを作成し、その中にcsvで書き出すプログラムを作りました。 また、AAAのフォルダの１つ上のフォルダ（VBA実行するカレントフォルダ）には、テキストファイルもあり、作成されたフォルダに合わせてコピーするようにしています。 一応、期待通りの動作をしましたが、スッキリとしたプログラムとするために、アドバイスをいただけないでしょうか？ また、できれば、それぞれのブックの2番目から7番目のワークシートのみをcsvファイルで書き出したいと思い、シートを2番目から順にアクティブにして書き出すように変更しても1番目のグラフシートからcsvになってしまいました。 特定のワークシートのみをcsvファイルで書き出すにはどのように書いたら良いでしょうか？ よろしくおねがいしむす Sub ファイル一括作成() Application.ScreenUpdating = False '対象ブックの選択 'フォルダ内のブックを順次選択 Dim FolderPath As String Dim objFSO As Object Dim objBook As Object Dim objFiles As Object Dim objFile As Object Dim mysma4 As Object Set objFSO = CreateObject("Scripting.FileSystemObject") FolderPath = ActiveWorkbook.Path & "\AAA" Set objBook = objFSO.GetFolder(FolderPath) Set objFiles = objFSO.GetFolder(FolderPath).Files Set mysma4 = objFSO.GetFile(ActiveWorkbook.Path & "\fig_all.TXT") For Each objFile In objFiles If objFSO.GetExtensionName(Path:=objFile) Like "xlsx" Then 'ベースファイル名フォルダ作成&sma4ファイルコピー objFSO.CreateFolder Path:=FolderPath & "\" & objFSO.GetBaseName(objFile) mysma4.Copy Destination:=FolderPath & "\" & objFSO.GetBaseName(objFile) & "\fig_all.TXT" '各ファイルcsv書き出し Workbooks.Open objFile.Path For Each ws In Worksheets '各シートに対して処理を繰り返す ws.Activate 'ベースファイルと同じ階層に出力 ActiveWorkbook.SaveAs _ Filename:=FolderPath & "\" & objFSO.GetBaseName(objFile) & "\" & ws.Name & ".csv", _ FileFormat:=xlCSV Next ws ActiveWorkbook.Close SaveChanges:=False Else End If Next MsgBox "ファイル作成が完了しました。" Set objFSO = Nothing Set objBook = Nothing Set objFiles = Nothing Set mysma4 = Nothing Application.ScreenUpdating = True End Sub
- ベストアンサー
- Excel（エクセル）
- VBA - 出力を希望のソートに変更したい
OS:Windows_11 EXCEL 2021 x64 txtでフォルダー内のファイルを一括読み込みするのに下記のコードを利用しています。 ターゲットフォルダーを指定してB列にファイルを読み込むと 下記のようにソートした「理想の状態」のはずなのに 実際は、下記の「実際の読み込み状態」で処理されてしまします。 「理想の状態」のようにソートして処理（出力）されるにはコードをどのように変更したら良いですか？ '----- 「理想の状態」 ---------- PGG - FDG.txt PGG - FDG_1.txt PGG - FDG_2.txt PGG - FDG_3.txt PGG - FDG_4.txt PGG - FDG_5.txt PGG - FDG_6.txt PGG - FDG_7.txt PGG - FDG_8.txt PGG - FDG_9.txt PGG - FDG_10.txt PGG - FDG_11.txt ’--- 「実際の読み込み状態」 --------------- PGG - FDG.txt PGG - FDG_1.txt PGG - FDG_10.txt PGG - FDG_11.txt PGG - FDG_2.txt PGG - FDG_3.txt PGG - FDG_4.txt PGG - FDG_5.txt PGG - FDG_6.txt PGG - FDG_7.txt PGG - FDG_8.txt PGG - FDG_9.txt '-------------------- 以下コード '変数宣言の指定 Option Explicit Sub フォルダー又はファイル名の取得() 'シート初期化 Range("A5:C100").ClearContents 'シート設定 Dim ws As Worksheet Set ws = Worksheets("フォルダファイル名変更") 'ファイルの選択ダイアログを表示してフルパスを取得 Dim objDialog As FileDialog 'FileDialogオブジェクト格納用変数 Dim targetPath As String 'ファイルパス格納用変数 Dim path As String 'フォルダパス取得 Set objDialog = Application.FileDialog(msoFileDialogFolderPicker) If objDialog.Show Then 'フォルダが選択された時は変数に選択されたファイルのパスを格納 path = objDialog.SelectedItems(1) 'デバック用 'MsgBox Path Else End If 'オブジェクト変数を解放 Set objDialog = Nothing '取得したフォルダURLを書き出す（処理には直接関係ないが確認のため） ws.Range("B2").Value = path 'FileSystemObjectの設定 Dim fs As Scripting.FileSystemObject Set fs = New Scripting.FileSystemObject 'フォルダを取得 Dim basefolder As Scripting.Folder Set basefolder = fs.GetFolder(path) '変数設定 Dim i As Long 'フォルダ内のフォルダを取得 Dim myfolders As Scripting.Folders Dim myfolder As Scripting.Folder Set myfolders = basefolder.SubFolders For Each myfolder In myfolders ws.Range("A5").Offset(i, 0).Value = "フォルダ" ws.Range("A5").Offset(i, 1).Value = myfolder.Name i = i + 1 Next 'フォルダ内のファイルを取得 Dim myfiles As Scripting.Files Dim myfile As Scripting.File Set myfiles = basefolder.Files For Each myfile In myfiles ws.Range("A5").Offset(i, 0).Value = "ファイル" ws.Range("A5").Offset(i, 1).Value = myfile.Name i = i + 1 Next 'オブジェクト解放 Set myfile = Nothing Set myfiles = Nothing Set myfolder = Nothing Set myfolders = Nothing Set basefolder = Nothing Set fs = Nothing 'プログラム終了 MsgBox "「1.フォルダ名又はファイル名の取得」 処理が終了しました。" End Sub
- ベストアンサー
- Excel（エクセル）
- FSOでエクセルファイルを作成したい
FSOでエクセルファイルを作成したいのですが、 ファイルの作成はできますが、作成したファイルが開けません。 Sub 新規Excelファイルを作成する() Dim MyFile As String Dim myFSO As Object MyFile = "管理簿.xlsx" Set myFSO = CreateObject("Scripting.FileSystemObject") With myFSO.CreateTextFile("C:\" & MyFile) .Close End With Set myFSO = Nothing End Sub で、エラーにならずうまくいっています。 が、その出来上がったファイルを開こうとすると 「ファイル形式またはファイル拡張子が正しくありません」 と言う旨のメッセージが表示されます。 何が間違ってますか？ よろしくお願いします。
- ベストアンサー
- Excel（エクセル）
お礼
mt2008 さん 回答ありがとうございます 思っていたことができました！