Question

我是VBA的新手，正在寻找解决这个问题的提示或提示。

我正在尝试遍历文件夹中的所有文件，并尝试将文件名分成三个部分，这些部分由下划线分隔，然后将它们粘贴到电子表格中。之后，转动它并计算新工作表中的文件数量。

例如，文件名：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

我错过了很多东西，不知道如何真正继续下去。这段代码给了我一个错误＆＃34;无效的程序调用＆＃34;当它到达G = Dir（）

时

感谢您的帮助!!!

Answer 1

首先，将文本粘贴在＆＃34;说明＆＃34;进入工作表的A1。然后将代码粘贴到＆＃34; Code＆＃34;进入一个模块。确保工作簿与.txt文件位于同一目录中。然后，运行宏。请参阅动画gif以获得结果。

＆＃34;说明＆＃34;

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

＆＃34;代码＆＃34;

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

Answer 2

未经测试但应该给你一些想法：

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 3

未经测试，但也许是这样的事情？

classes

循环文件夹中的文件并将文件名粘贴到电子表格中

3 个答案: