怎么批量导入txt文件到Excel，并实现文件名为一列，文本内容为一列

wsydize

具体问题如下，有大概200txt文件，每个文件的内容不固定，现在需要实现，第一列为txt名称，第二列为文本内容，行数等于文件数。有大神指教么。

lsc900707

没有附件，自行参照代码修改：
Sub aa()
Dim s As String
s = Dir(ThisWorkbook.Path & "/*.txt")
Do While s <> ""
Open ThisWorkbook.Path & "/" & s For Input As #1
  Do While Not EOF(1)
  i = i + 1
  Input #1, x
  Cells(i, 2) = x
  Cells(i, 1) = s
  Loop
  Close #1
s = Dir()
Loop
End Sub

wsydize

lsc900707 发表于 2016-8-30 12:22
没有附件，自行参照代码修改：
Sub aa()
Dim s As String

感谢大神，但是跟我的需求有些出入，您这个行数不是文本数，原因是每个文本不止一行，
例
1.txt
qwert
ertyui
2.txt
pou
lkjh

A     B
1   qwertertyui
2  poulkjh

大神有办法么

duquancai

wsydize 发表于 2016-8-30 12:32
感谢大神，但是跟我的需求有些出入，您这个行数不是文本数，原因是每个文本不止一行，
例
1.txt

必须提供附件，不要空谈！！！

jiminyanyan

没有附件。。。。。。。。。。

opiona

没有附件无法判断

参考：

1. 
   
2. Sub Opiona()
   
3. Dim f
   
4. 'On Error Resume Next
   
5. Application.ScreenUpdating = False '关闭屏幕刷新
   
6. Application.DisplayAlerts = False '关闭提示
   
7. t = Timer
   
8. s = "\*.txt"
   
9. Set sh1 = Sheets("读取后")
   
10. sh1.Cells.ClearContents
    
11. n = 1
    
12. f = Dir(ThisWorkbook.Path & s) '生成查找EXCEL的目录
    
13.     Do While f > " "   '在目录中循环
    
14.           sh1.Cells(n, 1) = ReadFromFileADO(ThisWorkbook.Path & "" & f, "UTF-8")
    
15.           n = n + 1
    
16.        f = Dir
    
17.     Loop
    
18. Application.ScreenUpdating = True
    
19. Application.DisplayAlerts = True
    
20. MsgBox "用时：" & Format(Timer - t, "#0.0000") & " 秒", , "北极狐提示!!"
    
21. End Sub
    
22. 
    
23. 
    
24. 
    
25. ’,需要添加对ADO 对象库的引用
    
26. 
    
27. ‘ADO方式读取
    
28. '功能：读取text文件（ADO方式,需要添加对ADO 对象库的引用）
    
29. '输入：输入文件地址、字符集
    
30. '输出：无
    
31. Function ReadFromFileADO(filePath As String, CharSet As String) As String
    
32.     Dim strRtn As String
    
33.   Set stm = CreateObject("ADODB.Stream")
    
34.     stm.Type = 2 '以本模式读取
    
35.     stm.Mode = 3
    
36.     stm.CharSet = CharSet
    
37.     stm.Open
    
38.     stm.LoadFromFile filePath
    
39.     strRtn = stm.ReadText
    
40.     stm.Close
    
41.     Set stm = Nothing
    
42.     ReadFromFileADO = strRtn
    
43. End Function

复制代码

huang1314wei

二楼说的很明白，没有附件，你就自己改代码，不会改，就老实的上附件

琴琴1122

来求解问题，连个附件都不带上的……大神们可真有耐心

jeep2700

琴琴1122 发表于 2016-8-30 16:48
来求解问题，连个附件都不带上的……大神们可真有耐心

个人表示  : 同意您的观点.