フォルダ内のファイルをループスルーしてスプレッドシートにファイル名を貼り付けます

Question

私はこの質問を解決するためのヒントやヒントを探しています。

私は、フォルダ内のすべてのファイルをループしようとアンダースコアで区切られた後、スプレッドシートに、それらを貼り付けされている3つの部分にファイル名を分割しようとしています。その後、それをピボットし、新しいシートにいくつのファイルがあるのか​​を数えます。例えば

、ファイル名：CA_File_20170810.txt

だから、それは次のようになります。

**IPA  TYPE  DATE   Filename  Filepath**  
    CA  File  20170810  

* IPA、タイプ、日付、ファイル名、ファイルパスは、Excelの列ヘッダです。ここで

は私が多くのことをしないのです

Sub LoopingThroughFiles() 

Dim f As String 
Dim G As String 
Dim File As Variant 
Dim MyObj As Object 
Dim MySource As Object 
Dim FileName As Variant 
Dim TypeName As Variant 

Cells(1, 1) = "IPA" 
Cells(1, 2) = "TYPE" 
Cells(1, 3) = "DATE" 
Cells(1, 4) = "FILENAME" 
Cells(1, 5) = "FILEPATH" 
Cells(2, 1).Select 

f = Dir("C:\Users\kxc8574\Documents\VBA_Practice\") 
G = Dir("C:\Users\kxc8574\Documents\VBA_Practice\") 

If Right(f, 1) <> "\" Then 
f = f + "\" 




Cells(2, 1).Select 

Do While Len(f) > 0 
IpaName = Left(f, InStr(f, "_") - 1) 
ActiveCell.Formula = IpaName 
ActiveCell.Offset(1, 0).Select 
f = Dir() 
Loop 
Do While Len(G) > 0 
TypeName = Mid(G, InStr(G, "_") + 1, InStr(G, "File_") - InStr(G, "_") - 1) 
ActiveCell.Formula = TypeName 
ActiveCell.Offset(1, 0).Select 
G = Dir() 

Loop 


End If 
End Sub 

これまでの私のコードでは、わからない、本当に継続する方法を持っているものです。このコードは、G = Dir（）に達したときにエラー "無効なプロシージャコール"を返します

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

Answer 1

未テスト

が、あなたにいくつかのアイデアを与える必要があります。このような

Sub LoopingThroughFiles() 

    Const FPATH As String = "C:\Users\kxc8574\Documents\VBA_Practice\" 

    Dim f As String, i As Long, arr, sht As Worksheet 

    Set sht = ActiveSheet 

    sht.Cells(1, 1).Resize(1, 5).Value = _ 
       Array("IPA", "TYPE", "DATE", "FILENAME", "FILEPATH") 

    f = Dir(FPATH & "*.txt") '<< only txt files 
    i = 2 
    Do While f <> "" 
     'split filename on underscore after replacing the ".txt" 
     arr = Split(Replace(f, ".txt", ""), "_", 3) 
     sht.Cells(i, 1).Resize(1, UBound(arr) + 1).Value = arr 
     sht.Cells(i, 4).Value = f 
     sht.Cells(i, 5).Value = FPATH 
     f = Dir() '<< next file 
     i = i + 1 
    Loop 

End Sub 

Answer 2

テストされていないが、おそらく何か？

Sub HashFiles() 
    Dim MyDir As String, MyIPA As Variant, MyType As Variant, MyDate As Variant, i As Integer, oFile As Object, oFSO As Object, oFolder As Object, oFiles As Object 
    MyDir = "C:\Users\kxc8574\Documents\VBA_Practice\" 
    Set oFSO = CreateObject("Scripting.FileSystemObject") 
    Set oFolder = oFSO.GetFolder(MyDir) 
    Set oFiles = oFolder.Files 
    ReDim MyIPA(1 To oFiles.Count) 
    ReDim MyType(1 To oFiles.Count) 
    ReDim MyDate(1 To oFiles.Count) 
    i = 1 
    For Each oFile In oFiles 
     MyIPA(i) = Split(oFile.Name, "_")(0) 
     MyType(i) = Split(oFile.Name, "_")(1) 
     MyDate(i) = Split(oFile.Name, "_")(2) 
     i = i + 1 
    Next 
    Range("A2").Resize(UBound(MyIPA) + 1, 1) = Application.Transpose(MyIPA) 
    Range("B2").Resize(UBound(MyType) + 1, 1) = Application.Transpose(MyType) 
    Range("C2").Resize(UBound(MyDate) + 1, 1) = Application.Transpose(MyDate) 
End Sub 

Answer 3

最初に、「説明」のテキストをワークシートのA1に貼り付けます。次に、コードの下にコードをモジュールに貼り付けます。ワークブックが.txtファイルと同じディレクトリにあることを確認します。次に、マクロを実行します。結果についてはアニメーションGIFを参照してください。

"解説"

This workbook contains a macro which will 
1) Make a new sheet in this workbook named "Combined" 
2) Open a copy of each .txt file located in the same directory as this workbook 
3) extract the text between "_" characters 
4) place the separated text into columns 
5) count the number of .txt files processed 
Note: Any sheet named "Combined" in this Workbook will be deleted 

"コード"

Option Explicit 
Sub CombineFiles() 
Dim theDir As String, theFile As String 
Dim sh As Worksheet, wk As Workbook, newSheet As Worksheet 
Dim r As Range, parts() As String 
Dim i As Long, s As String 
Dim Done As Boolean, numFiles As Integer 
Const ext = ".txt" 
    Err.Clear 
    theDir = ThisWorkbook.Path 
    'explain what program does 
    Worksheets("Program").Select 
    For i = 1 To 7 
    s = s & Cells(i, 1) & vbCr & vbCr 
    Next i 
    s = s & vbCr 
    s = MsgBox(s, vbYesNoCancel, "What this macro does") 
    If s <> vbYes Then End 
    For Each sh In Worksheets 
     If sh.Name = "Combined" Then 
      Application.DisplayAlerts = False 
      sh.Delete 
      Application.DisplayAlerts = True 
     End If 
    Next 
    Set newSheet = ThisWorkbook.Sheets.Add 
    newSheet.Name = "Combined" 
    'Loop through all files in directory with ext 
    s = Dir(theDir & "\*" & ext) 
    Set r = Range("A1") 
    r = "IPA" 
    r.Offset(0, 1) = "Type" 
    r.Offset(0, 2) = "Date" 
    r.Offset(0, 3) = "filename" 
    r.Offset(0, 4) = "filepath" 
    While s <> "" 
     numFiles = numFiles + 1 
     parts = Split(s, "_") 
     Set r = r.Offset(1, 0) 
     For i = 0 To 2 
     r.Offset(, i) = Replace(parts(i), ".txt", "") 
     Next i 
     r.Offset(, 3) = s 
     r.Offset(, 4) = theDir & "\" & s & ext 
     s = Dir() 
    Wend 
    MsgBox (numFiles & " files were processed.") 
End Sub