提取TXT文件内容到指定单元格

你地铁图

你这txt的内容是OCR出来的吗

135294560056

下面代码，执行时候把存放代码的文件和需要读取的txt文件放在同一个文件夹即可

1. Sub 遍历文件夹()
   
2.     Dim arr0(), arr1()
   
3.     Dim arr
   
4.     Dim bkName, pth, bkNames, i, k, k1, j
   
5.     bkName = ThisWorkbook.Name
   
6.     pth = ThisWorkbook.Path
   
7.     bkNames = Dir(pth & "" & "*.*")
   
8.     Do Until bkNames = ""
   
9.         If bkNames <> bkName And bkNames Like "*.txt*" Then
   
10.             i = i + 1
    
11.             ReDim Preserve arr0(1 To i)
    
12.             arr0(i) = bkNames
    
13.         End If
    
14.         bkNames = Dir
    
15.     Loop
    
16.     For k = 1 To UBound(arr0)
    
17.         Dim objstream, strData
    
18.         Dim Str$
    
19.         Set objstream = CreateObject("ADODB.Stream")
    
20.         objstream.Charset = "utf-8"
    
21.         objstream.Open
    
22.         objstream.LoadFromFile (ThisWorkbook.Path & "" & arr0(k))
    
23.         strData = objstream.ReadText()
    
24.         arr = Split(strData, vbCrLf)
    
25.         Str = ""
    
26.         For j = 0 To UBound(arr) - 1
    
27.             Str = Str & arr(j)
    
28.         Next
    
29.         objstream.Close
    
30.         Set objstream = Nothing
    
31.         k1 = k1 + 1
    
32.         ReDim Preserve arr1(1 To k1)
    
33.         arr1(k1) = Str
    
34.     Next
    
35.     Range("r2:r" & UBound(arr1) + 1) = Application.Transpose(arr1)
    
36. End Sub

复制代码

135294560056

wps测试通过

wdh540119878

你地铁图 发表于 2023-5-16 20:45
你这txt的内容是OCR出来的吗

是的，双层PDF提取出来的

wdh540119878

gwjkkkkk 发表于 2023-5-16 20:44
我测试没问题啊，数据都提出来了，是不是WPS的关系 。。。。

明天我再试试装个office，手机上回复的

wdh540119878

135294560056 发表于 2023-5-16 23:08
wps测试通过

明天我试试。这会手机上回复呢，谢谢大哥了

wdh540119878

135294560056 发表于 2023-5-16 23:08
wps测试通过

用这个测试可以了 但是是把TXT得放到2012文件夹内，并不是说的放到放在同一个文件夹，能不能改成，本文件内含所有子文件夹内的TXT

wdh540119878

gwjkkkkk 发表于 2023-5-16 20:44
我测试没问题啊，数据都提出来了，是不是WPS的关系 。。。。

感谢大哥，我说错了，是office报那个错，WPS可以正常运行，代码能不能改成本文件夹含子文件夹内的TXT，不用必须放到2012文件夹里面

给我来份麦当劳

wdh540119878 发表于 2023-5-16 19:11
刚上传了 大哥

大神，我这边有个类似的，不过我是依次放入A列中的单元格中去，每个Txt文档对应一个单元格，希望大神给我写一个类似的vba代码，非常感谢~~~