循环浏览文件夹中的文件并将文件名粘贴到电子表格中
我对VBA是完全陌生的，寻找提示或提示来解决这个问题。
我试图遍历一个文件夹中的所有文件，并试图将文件名拆分成三部分，用下划线分隔，然后将其粘贴到电子表格中。 之后，转动它并计算新工作表中有多less个文件。
例如，文件名：CA_File_20170810.txt
所以看起来像这样：
**IPA TYPE DATE Filename Filepath** CA File 20170810 * IPA，types，date，文件名，文件path是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（）时给了我一个错误“invalid procedure call”
谢谢你的帮助 ！！！
首先，将“说明”下的文本粘贴到工作表的A1中。 然后将“代码”下的代码粘贴到模块中。 确保工作簿与.txt文件位于同一目录中。 然后，运行macros。 查看结果的animationgif。
“说明”
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
未经testing，但应该给你一些想法：
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
未经testing，但也许这样？
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