如何将指定文件夹下txt文件内容分别批量导入到该文件下word文件中

xiawj0

将指定文件夹下txt文件内容分别批量导入到该文件下word文件中


文件夹有个A.txt文件和按序号排列的100个word文档，文档是按顺序排列的1-100的文档，


A.txt文件中的内容为：
“1.赵建军
2.赵如芹
3.翟志文
4.翟三只
5.申风怀
6.申兰芳
7.赵平兰
8.薛海金
9.赵希海…………

100.王家一”


如何将A.txt中内容1.赵建军导入到1.赵建军的word文档第一行；将A.txt中内容2.赵如芹导入到2.赵如芹的word文档；将A.txt中内容3.翟志文导入到3.翟志文的word文档……依次导入每个word文档的第一行


感谢大佬帮忙解决

3190496160

求助务必上传附件才可能得到别人的帮助

xiawj0

3190496160 发表于 2022-9-28 15:29
求助务必上传附件才可能得到别人的帮助

附件已经上传，感谢大佬帮忙

413191246se

楼主，一是附件太过简单，应该多来几个段落。二是其实你的问题可以直接读入 TXT，然后截取一段另存一段即可，当然是用 VBA。

xiawj0

413191246se 发表于 2022-9-28 18:11
楼主，一是附件太过简单，应该多来几个段落。二是其实你的问题可以直接读入 TXT，然后截取一段另存一段即可 ...

第一点的段落是具体指什么？像这样的附件文件有大概1000个左右，序号1-1000。
第二点说的可以尝试大佬所说的VBA"截取一段另存一段"的方法怎么实现？大佬可以给个解决方法吗？

413191246se

1. Sub a0929_TextSplit()
   
2.     Dim r As Range
   
3.     MkDir "d:\zzz"
   
4.     ActiveDocument.Content.InsertParagraphAfter
   
5.     ActiveDocument.Content.Find.Execute "([0-9]{1,})[．、]", , , 1, , , , , , "\1.", 2
   
6.     With Selection
   
7.         .HomeKey 6
   
8.         Do
   
9.             Do
   
10.                 .MoveEnd 4
    
11.             Loop Until .Next(4, 1) Like "#.*" Or .Next(4, 1) Like "##.*" Or .Next(4, 1) Like "###.*" Or .Next(4, 1) Like "####.*" Or .Next(4, 1).End = ActiveDocument.Content.End
    
12.             Set r = .Range
    
13.             Documents.Add.Content.Text = r.Text
    
14.             ActiveDocument.SaveAs FileName:="d:\zzz" & Replace(ActiveDocument.Paragraphs(1).Range, vbCr, "") & ".docx"
    
15.             ActiveDocument.Close
    
16.             r.Delete
    
17.         Loop Until ActiveDocument.Paragraphs.Count = 1
    
18.     End With
    
19.     ActiveDocument.Close 0
    
20.     MsgBox "Complete!", 0 + 48
    
21. End Sub

复制代码

xiawj0

413191246se 发表于 2022-9-29 02:29

提示错误是什么回事？

xiawj0

413191246se 发表于 2022-9-29 02:29

提示错误是什么回事？

413191246se

这句代码是在 D 盘建立目录“zzz”，你的电脑有没有 D 盘呀？
你可以将此行代码删除（或注释掉），然后，自己主动在 D 盘建立一个新文件夹“zzz”，再运行程序。