如何用vba读取多个txt文件名和txt文件内容写入excel中?

在多个txt文件的文件夹中新建一个EXCEL，在其VBA中输入ReadTextFiles()，然后运行：

Sub ReadTextFiles()
Dim n As Long, a(), ff As Integer, txt As String, myDir As String, x
Dim myF As String, i As Long
myDir = ThisWorkbook.Path & Application.PathSeparator
myF = Dir(myDir & "*.txt")
Do While myF <> ""
ff = FreeFile
Open myDir & myF For Input As #ff
Do While Not EOF(ff)
Line Input #ff, txt
x = Split(txt, "|")
n = n 1
ReDim Preserve a(1 To n)
a(n) = x
Loop
Close #ff
myF = Dir()
Loop
Cells.Clear
With ThisWorkbook.Worksheets("Sheet1").Range("a1")
For i = 1 To UBound(a)
.Offset(i - 1).Resize(, UBound(a(i)) 1) = a(i)
Next
End With
End Sub

可以运行下面这段代码，稍加调试一可以达到目标了。

Sub cht()
Dim objFSO As Object, objFile As Objectg
Dim txtpath As String, cr As Long, ct As String, d As String, allt
txtpath = ThisWorkbook.Path & "\text.txt" '该为你自己的路径
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.OpenTextFile(txtpath, 1)
d = objFile.ReadAll
allt = Split(d, vbCrLf, -1, 1)
objFile.Close
cr = InputBox("输入需要更改的文本行数")
ct = InputBox("输入需要更改的文本内容")
allt(cr - 1) = ct
Set objFile = objFSO.createtextfile(txtpath, 1)
d = Join(allt, vbCrLf)
objFile.write d
objFile.Close
Set objFile = Nothing: Set objFSO = Nothing
End Sub

还有另一种方法， 创建FILEDIALOG 对像，MSOFILEPICKER， MULTIPLE SELECTION, SELECTED ITEMS 做个循环，用QUERYTABLE.ADD 加到空表上。

n = n+1
.Offset(i - 1).Resize(, UBound(a(i)) 1) = a(i)