在文件中搜索文本并创建doc文件 [英] search in files for text and create doc files

问题描述

我在一个文件夹中有大约1000个docx文件。我还有一个docx文件（我们称之为mytemplate.docx）。在这个文件中，我有一些模板字符串，如（"mydate"，"myname"，"mynomber"......），我必须用这些
1000 docx文件中的信息替换，并保存一个特定的名称每一个人。示例：

打开第一个docx文件

在其中搜索日期

替换mytamplate"数值指明MyDate"找到日期

以及其他字段

然后将mytamplate.docx保存为我搜索到的docx的名称加上somethig （比如docxnameB）为了不覆盖docx（docx的名称是唯一的）。

等等所有那些1000 docx

在docx我必须搜索我知道包含我搜索的信息的字符串。示例：

" ....日期之前的文本：日期之后的日期文本日期。"这个封闭的字符串是唯一的。

你能帮帮我吗？

有没有办法检索这些信息，只知道前面提到的唯一字符串和按照？

解决方案

关于日期，如果您包含日期格式会有所帮助，但以下假定日期像dd / MM / yyyy或类似的格式。即一个没有空格的。根据需要更改路径和Text Before Date字符串。

文件保存在单独的文件夹中（如果不存在则创建）以保持简单。模板和原始文档不会更改。

在尝试处理许多文档之前，我是否可以建议您使用文件夹中的一些文档进行尝试。

< pre class ="prettyprint"> Option Explicit

Sub Macro1（）
'Graham Mayor - https://www.gmayor.com - Last updated - 201 Dec 2018'
Const strTemplate As String =" C：\ Path\TemplateName.docx"
Const strPath As String =" C：\ Path\Docs \"
Const strSavePath As String =" C：\ Path\Docs \ Revised\"
Dim FSO As Object
Dim strFile As String
Dim oSource As Document
Dim oTarget As Document
Dim oRng As Range
Dim strDate As String

设置FSO = CreateObject（" Scripting.FileSystemObject"）
如果不是FSO.FileExists（strTemplate）那么
MsgBox" Template" &安培; vbCr& strTemplate& vbCr& "不存在:("
GoTo lbl_Exit
结束如果
如果不是FSO.FolderExists（strPath）那么
MsgBox"文件夹"& vbCr& _
strPath& vbCr& _
"不存在:("
GoTo lbl_Exit
End if
MsgBox"请耐心等待 - 这可能需要一段时间。"
CreateFolders strSavePath
strFile = Dir

（strPath&" * .do？"）
strFile< >""
设置oSource = Documents.Open（strPath& strFile）
设置oTarget = Documents.Add（strTemplate）
设置oRng = oSource.Range
随附oRng.Find
Do While .Execute（FindText：=" TEXT BEFORE："）
oRng.Collapse 0
oRng.MoveEndUntil Chr（32）
If IsDate（ oRng.Text）然后strDate = oRng.Text
Exi t $
循环
结束
设置oRng = oTarget.Range
使用oRng.Find
Do While .Execute（FindText：=" mydate"）
oRng.Text = strDate
oRng.Collapse 0
Loop
End with
oTarget.SaveAs2 FileName：= strSavePath& oSource.Name，AddToRecentFiles：= False
oTarget.Close
oSource.Close savechanges：= wdDoNotSaveChanges
DoEvents
strFile = Dir

（ ）
Wend
lbl_Exit：
Set oSource = Nothing
Set oTarget = Nothing
Set oRng = Nothing
Set FSO = Nothing
Exit Sub
结束子

私人功能CreateFolders（strPath As String）
'格雷厄姆市长 - https://www.gmayor.com-最后更新 - 2017年5月31日'
'如果缺少或不完整，则创建完整路径'strPath''
Dim strTempPath As String
Dim lng_Path As Long
Dim VPath As Variant
Dim oFSO As Object
Dim i As Integer
设置oFSO = CreateObject（" Scripting.FileSystemObject"）
VPath = Split（strPath，" \"）
如果Left（strPath，2）=" ; \\"然后
strPath =" \\" &安培; VPath（2）& " \"
对于lng_Path = 3到UBound（VPath）
strPath = strPath& VPath（lng_Path）& " \"
如果不是oFSO.FolderExists（strPath）那么MkDir strPath
下一个lng_Path
否则
strPath = VPath（0）& " \"
对于lng_Path = 1到UBound（VPath）
strPath = strPath& VPath（lng_Path）& " \"
如果不是oFSO.FolderExists（strPath）那么MkDir strPath
下一个lng_Path
结束如果
lbl_Exit：
设置oFSO = Nothing
退出函数
结束函数

Hi,

I have about 1000 docx files in a folder. I also have a docx file (lets call it mytemplate.docx). In this file i have some template strings like ("mydate", "myname", "mynomber"...) which I have to replace with info from those 1000 docx files and save with a specific name for each one. Example:

open first docx file

search in it for a date

replace in mytamplate "mydate" with the date found

and so on with the other fields

then save mytamplate.docx with the name of the docx in wich I searched plus somethig (like docxnameB) in order to not overwrite the docx (the names of docx are unique).

and so on for all those 1000 docx

in the docx I have to search I know the strings that enclose the info i search for. Example:

"....TEXT BEFORE DATE: dateIsearchfor TEXT AFTER DATE." This enclosing strings are unique.

Can you help me please?

Is there a way to retrieve those information knowing only the unique strings that preced and follow?

解决方案

With regard to the date, it would have helped if you had included the date format, however the following assumes a date format like dd/MM/yyyy or similar. i.e. one with no spaces. Change the paths and the Text Before Date string as appropriate.

The files are saved in a separate folder (created if not present) to keep things simple. The template and the original documents are not changed.

Can I suggest that you try it with a few documents in a folder before attempting to process many.

Option Explicit

Sub Macro1()
'Graham Mayor - https://www.gmayor.com - Last updated - 21 Dec 2018'
Const strTemplate As String = "C:\Path\TemplateName.docx"
Const strPath As String = "C:\Path\Docs\"
Const strSavePath As String = "C:\Path\Docs\Revised\"
Dim FSO As Object
Dim strFile As String
Dim oSource As Document
Dim oTarget As Document
Dim oRng As Range
Dim strDate As String

    Set FSO = CreateObject("Scripting.FileSystemObject")
    If Not FSO.FileExists(strTemplate) Then
        MsgBox "Template" & vbCr & strTemplate & vbCr & "does not exist :("
        GoTo lbl_Exit
    End If
    If Not FSO.FolderExists(strPath) Then
        MsgBox "The document folder" & vbCr & _
               strPath & vbCr & _
               "does not exist :("
        GoTo lbl_Exit
    End If
    MsgBox "Be patient - this could take a while."
    CreateFolders strSavePath
    strFile = Dir

(strPath & "*.do?") While strFile <> "" Set oSource = Documents.Open(strPath & strFile) Set oTarget = Documents.Add(strTemplate) Set oRng = oSource.Range With oRng.Find Do While .Execute(FindText:="TEXT BEFORE DATE: ") oRng.Collapse 0 oRng.MoveEndUntil Chr(32) If IsDate(oRng.Text) Then strDate = oRng.Text Exit Do Loop End With Set oRng = oTarget.Range With oRng.Find Do While .Execute(FindText:="mydate") oRng.Text = strDate oRng.Collapse 0 Loop End With oTarget.SaveAs2 FileName:=strSavePath & oSource.Name, AddToRecentFiles:=False oTarget.Close oSource.Close savechanges:=wdDoNotSaveChanges DoEvents strFile = Dir

() Wend lbl_Exit: Set oSource = Nothing Set oTarget = Nothing Set oRng = Nothing Set FSO = Nothing Exit Sub End Sub Private Function CreateFolders(strPath As String) 'Graham Mayor - https://www.gmayor.com - Last updated - 31 May 2017' 'Creates the full path 'strPath' if missing or incomplete' Dim strTempPath As String Dim lng_Path As Long Dim VPath As Variant Dim oFSO As Object Dim i As Integer Set oFSO = CreateObject("Scripting.FileSystemObject") VPath = Split(strPath, "\") If Left(strPath, 2) = "\\" Then strPath = "\\" & VPath(2) & "\" For lng_Path = 3 To UBound(VPath) strPath = strPath & VPath(lng_Path) & "\" If Not oFSO.FolderExists(strPath) Then MkDir strPath Next lng_Path Else strPath = VPath(0) & "\" For lng_Path = 1 To UBound(VPath) strPath = strPath & VPath(lng_Path) & "\" If Not oFSO.FolderExists(strPath) Then MkDir strPath Next lng_Path End If lbl_Exit: Set oFSO = Nothing Exit Function End Function

这篇关于在文件中搜索文本并创建doc文件的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！