我有一个代码将不同的多个.txt文件的全部内容放入Excel 2010中，但需要进行一些更改

有什么办法可以将不同的多个.txt文件（实际上是一个文件夹中的所有.txt文件的内容）的整个内容放入Excel 2010？ 我需要一个单元格（A1）作为文件的名称，另一个单元格（A2）作为该.txt文件的全部内容。 其他.txt文件也是如此，即B1-B2，C1-C2等。

我有这个代码：

Sub test() Dim myDir As String, fn As String, ff As Integer, txt As String Dim delim As String, n As Long, b(), flg As Boolean, x myDir = "c:\test" '<- change to actual folder path delim = vbTab '<- delimiter (assuming Tab delimited) Redim b(1 To Rows.Count, 1 To 1) fn = Dir(myDir & "\*.txt") Do While fn <> "" ff = FreeFile Open myDir & "\" & fn For Input As #ff Do While Not EOF(ff) Line Input #ff, txt x = Split(txt, delim) If Not flg Then n = n + 1 : b(n,1) = fn End If If UBound(x) > 0 Then n = n + 1 b(n,1) = x(1) End If flg = True Loop Close #ff flg = False fn = Dir() Loop ThisWorkbook.Sheets(1).Range("a1").Resize(n).Value = b End Sub 

但这个代码的事情是，它只导入文件名，而不是内容，我想这是由于上述代码使用“delim = vbTab”的事实，我没有任何分隔符的内容文件。 我想要将一个文件的全部内容导入到一个单元格中。

Answer 1

FileSystemObject （Microsoft Scripting Runtime的一部分）提供了一个好的文件处理select。

这是一个使用这个模块的简要概述。

注意：

1. 它利用早期绑定，因此需要参考脚本运行时。 如果您愿意，可以很容易地修改为后期绑定。
2. 为了清晰起见，我省略了error handling和各种速度优化。 是否足够安全或足够快将取决于您的预期用途和文件的数量和大小。

---

 Sub test() Dim fso As FileSystemObject Dim txt As TextStream Dim pth As String Dim fl As File Dim str As String Dim cl As Range Set fso = New FileSystemObject pth = "C:\Test" Set cl = [A1] For Each fl In fso.GetFolder(pth).Files If StrComp(Right(fl.Name, 4), ".txt", vbTextCompare) = 0 Then Set txt = fso.OpenTextFile(fl.Path, ForReading) cl = fl.Name str = txt.ReadAll ' option: use this loop to split long files into multiple cells Do While Len(str) > 32767 cl.Offset(0, 1) = Left(str, 32767) Set cl = cl.Offset(0, 1) str = Mid(str, 32768) Loop cl.Offset(0, 1) = str Set cl = cl.EntireRow.Cells(2, 1) txt.Close End If Next Set txt = Nothing Set fso = Nothing End Sub 

Answer 2

这不是你使用的方法，但我这样做：

 Option Explicit Sub ImportManyTXTIntoColumns() 'Summary: From a specific folder, import TXT files 1 file per column Dim fPath As String, fTXT As String Dim wsTrgt As Worksheet, NC As Long Application.ScreenUpdating = False fPath = "C:\2010\" 'path to files Set wsTrgt = ThisWorkbook.Sheets.Add 'new sheet for incoming data NC = 1 'first column for data fTXT = Dir(fPath & "*.txt") 'get first filename Do While Len(fTXT) > 0 'process one at a time 'open the file in Excel Workbooks.OpenText fPath & fTXT, Origin:=437 'put the filename in the target column wsTrgt.Cells(1, NC) = ActiveSheet.Name 'copy column A to new sheet Range("A:A").SpecialCells(xlConstants).Copy wsTrgt.Cells(2, NC) ActiveWorkbook.Close False 'close the source file NC = NC + 1 'next column fTXT = Dir 'next file Loop Application.ScreenUpdating = True End Sub