Vba 创建新文件夹时如何复制预先存在的Word文档？

我有一个宏，可以为每个包含附件的电子邮件创建一个文件夹，并存储其附件

我希望将现有Word文档复制到创建的每个新文件夹中

我尝试了

fileCopy

，但无法使其工作，因为目标是可变的

Option Explicit

Sub Application_Startup()

Dim ol As Outlook.Application
Dim ns As Outlook.Namespace
Dim fol As Outlook.Folder
Dim i As Object
Dim mi As Outlook.MailItem
Dim at As Outlook.Attachment
Dim rootfol As Outlook.Folder
Dim fso As Scripting.FileSystemObject
Dim dir As Scripting.Folder
Dim dirName As String

Set fso = New Scripting.FileSystemObject

Set ol = New Outlook.Application
Set ns = ol.GetNamespace("MAPI")
Set rootfol = ns.Folders(1)
Set fol = rootfol.Folders("boîte de réception").Folders("test")

For Each i In fol.Items
    If i.Class = olMail Then
        Set mi = i
        If mi.Attachments.Count > 0 Then

           dirName = "C:\Users\chadi\OneDrive\Documents\VBA\" & Format(mi.ReceivedTime, "yyyy-mm-dd hh-nn-ss ") & Left(Replace(mi.Subject, ":", ""), 20)

           If fso.FolderExists(dirName) Then
              Set dir = fso.GetFolder(dirName)
           Else
              Set dir = fso.CreateFolder(dirName)
           End If

           For Each at In mi.Attachments
               at.SaveAsFile dir.Path & "\" & at.Filename
           Next at

        End If
    End If
Next i

End Sub

---

也许其他人可以在不需要更多信息的情况下为您提供更好的答案，但我需要您更具体地说明此文件的可变性，因为我无法使用VBA代码回答您的问题

在您的示例中，我也没有看到

FileCopy

[编辑]

我注释掉了文件选择并添加了新代码，这些代码应该与您提供的新信息一起使用

[重要]我假设您使用的是Windows。您需要按住Shift键并在Word文档上单击鼠标右键，然后选择“复制为路径”。然后，您需要在新代码中粘贴路径，以完全替换路径。如果操作正确，它应该类似于

mySpecialWordDocument=“C:\MyDirectory\MyFiles\MyFile.docx”

---

它会打开一个对话框窗口，供用户选择一个文件并将该文件复制到新文件夹中

---

要回答您提出的问题，您需要告诉我如何手动决定选择哪个文件。

谢谢您的回答。我没有在上面的代码中使用FileCopy，因为它不工作。当我说新文件夹是可变的时，我的意思是每次我收到一封电子邮件，宏都会自动创建一个新文件夹，提取电子邮件的所有附件并将其放在这个新文件夹中。但我也希望，随着每个新文件夹的创建，在其中插入一个word文档。这有意义吗？对不起我的英语！我是法国人！我刚刚使用了你的代码，它几乎完美无瑕。我只是不想手动选择word文档。我想它会自动复制到每个新创建的文件夹！具体点。这个Word文档来自哪里？您如何知道要复制哪个Word文档？为什么

FileCopy

不起作用？

文件复制

是否会给您带来错误？这是什么错误？我需要您未提供的特定信息。此word文档已保存在我的驱动器上。我知道要复制哪一个，因为它将始终是必须复制到所有这些文件夹中的同一word文档。我不知道如何编写

FileCopy

代码，因为我需要一个目标源代码，我不知道如何编写它。我没有出错，因为我没有尝试正确编码

文件副本

@MelanieDeschene谢谢。我理解。我更新了答案，应该对你有用（但我承认我没有测试过）。请注意，您必须按照我提供的说明编辑代码。除非用Word文档的实际路径替换

[在此处粘贴路径]

，否则它将不起作用。通过在Windows文件资源管理器中右键单击文档并选择“复制为路径”，可以轻松复制和粘贴路径。

       If fso.FolderExists(dirName) Then
          Set dir = fso.GetFolder(dirName)
       Else
          Set dir = fso.CreateFolder(dirName)
          'With Application.FileDialog(msoFileDialogFilePicker)
             '.AllowMultiSelect = False
             '.Filters.Clear
             'If .Show Then fso.CopyFile .SelectedItems(1), dirName & "\" & Split(.SelectedItems(1), "\")(UBound(Split(.SelectedItems(1), "\")))
          'End With

          Dim mySpecialWordDocument as String
          mySpecialWordDocument= [paste the path here]
          fso.CopyFile mySpecialWordDocument, dirName & "\" & Split(mySpecialWordDocument, "\")(UBound(Split(mySpecialWordDocument, "\")))

       End If