Vba 将文件保存在指定文件夹中

这是源代码

该代码将一个序列号分隔为单独的文件，将其保存为pdf并开始打印

宏将所有文件保存在同一文件夹中，我必须手动将每个文件移动到指定的文件夹中（每个文件都有自己的文件夹，其名称为代码中的“编号”）

---

是否可以将文件直接保存到指定的文件夹中？

我会这样做：

Dim num，numGen作为long，f，StrFolder作为String
'...
'...
num=.DataFields（“Number”）捕获With.DataSource块中的值
'...
'...
'检查目标文件夹是否存在
f=FindFolder（StrFolder，CStr（num））'返回文件夹路径（如果存在）
如果Len（f）=0，则
'未找到匹配项-使用常规文件夹
f=StrFolder&“General”或任何您想要的
numGen=numGen+1
如果结束
.SaveAs2文件名：=f&_
Application.PathSeparator和StrName&“.pdf”_
FileFormat:=wdFormatPDF，AddToRecentFiles:=False
'...
'...
'通知某些文件需要移动
如果numGen>0，则
Msgbox numGen&“文件已保存到“常规”文件夹”
如果结束

此函数将返回给定起始文件夹的任何匹配文件夹的路径（包括在子文件夹中搜索）。如果不匹配，则返回空字符串

函数FindFolder（StartAt作为字符串，ByVal folderName作为字符串）作为字符串
将文件夹设置为新集合、sf、路径、fld、fso
设置fso=CreateObject（“scripting.filesystemobject”）
colFolders.addstartat
在关闭文件夹时执行此操作。计数>0
fld=colFolders（1）
colFolders。删除1
如果正确（fld，1）“\”则fld=fld&“\”
对于fso.getfolder（fld）.子文件夹中的每个sf
如果sf.Name=folderName，则
FindFolder=sf.path
退出功能
其他的
colFolders.addsf
如果结束
下一个sf
环
端函数

我会这样做：

Dim num，numGen作为long，f，StrFolder作为String
'...
'...
num=.DataFields（“Number”）捕获With.DataSource块中的值
'...
'...
'检查目标文件夹是否存在
f=FindFolder（StrFolder，CStr（num））'返回文件夹路径（如果存在）
如果Len（f）=0，则
'未找到匹配项-使用常规文件夹
f=StrFolder&“General”或任何您想要的
numGen=numGen+1
如果结束
.SaveAs2文件名：=f&_
Application.PathSeparator和StrName&“.pdf”_
FileFormat:=wdFormatPDF，AddToRecentFiles:=False
'...
'...
'通知某些文件需要移动
如果numGen>0，则
Msgbox numGen&“文件已保存到“常规”文件夹”
如果结束

此函数将返回给定起始文件夹的任何匹配文件夹的路径（包括在子文件夹中搜索）。如果不匹配，则返回空字符串

函数FindFolder（StartAt作为字符串，ByVal folderName作为字符串）作为字符串
将文件夹设置为新集合、sf、路径、fld、fso
设置fso=CreateObject（“scripting.filesystemobject”）
colFolders.addstartat
在关闭文件夹时执行此操作。计数>0
fld=colFolders（1）
colFolders。删除1
如果正确（fld，1）“\”则fld=fld&“\”
对于fso.getfolder（fld）.子文件夹中的每个sf
如果sf.Name=folderName，则
FindFolder=sf.path
退出功能
其他的
colFolders.addsf
如果结束
下一个sf
环
端函数

您的代码来源于邮件合并提示和技巧线程中的“将邮件合并输出发送到单个文件”一文，位于

---

这篇文章包含设置保存路径的代码，并告诉您如何使用它…

您的代码来自于邮件合并提示和技巧线程中的“将邮件合并输出发送到单个文件”文章，位于

---

那篇文章包含设置保存路径的代码，并告诉您如何使用它。

是否在某个地方设置了

StrPath

？你的意思是

StrFolder

？StrPath设置在什么地方了吗？你是说StrFolder吗？谢谢你的帮助。我试过了，文件保存在正确的文件夹中。不幸的是，我面临另一个问题。问题涉及以下方面。如果文件的指定文件夹尚不存在，则宏将停止工作。是否可以设置一个常规文件夹并将所有没有指定文件夹的文件保存在此文件夹中？这样，makro会将文件与现有文件夹一起保存在指定文件夹中，并将所有其他文件夹保存在常规文件夹中。提前谢谢，圣诞快乐！如果“数字”文件夹不存在，让宏创建它会更好吗？不幸的是，文件夹已经存在，但没有数字（只有人的名字）。文件夹的编号稍后会手动添加，但有时掌权者会忘记这样做。因此，创建新文件夹将意味着有些人有2个文件夹。好的，请参阅上面的编辑对不起，回复太晚，我很忙。我可以试试你的代码，它是有效的。非常感谢你的帮助。我试过了，文件保存在正确的文件夹中。不幸的是，我面临另一个问题。问题涉及以下方面。如果文件的指定文件夹尚不存在，则宏将停止工作。是否可以设置一个常规文件夹并将所有没有指定文件夹的文件保存在此文件夹中？这样，makro会将文件与现有文件夹一起保存在指定文件夹中，并将所有其他文件夹保存在常规文件夹中。提前谢谢，圣诞快乐！如果“数字”文件夹不存在，让宏创建它会更好吗？不幸的是，文件夹已经存在，但没有数字（只有人的名字）。文件夹的编号稍后会手动添加，但有时掌权者会忘记添加

Sub Merge_To_Individual_Files()
Application.ScreenUpdating = False
Dim StrFolder As String, StrName As String, MainDoc As Document, i As Long, j As Long
Set MainDoc = ActiveDocument
With MainDoc
  StrFolder = .Path & Application.PathSeparator
  For i = 1 To .MailMerge.DataSource.RecordCount
    With .MailMerge
      .Destination = wdSendToNewDocument
      .SuppressBlankLines = True
      With .DataSource
        .FirstRecord = i
        .LastRecord = i
        .ActiveRecord = i
        If Trim(.DataFields("Name")) = "" Then Exit For
        StrName = .DataFields("Number") & "_" & .DataFields("Name") & "_Test"
      End With
      .Execute Pause:=False
    End With
    StrName = Trim(StrName)
    With ActiveDocument
      .SaveAs2 FileName:=StrFolder & StrName & ".pdf", FileFormat:=wdFormatPDF, AddToRecentFiles:=False
      .PrintOut Copies:=1
      .Close SaveChanges:=False
    End With
  Next i
End With
Application.ScreenUpdating = True
End Sub