Question

我定期在一封电子邮件中收到两份excel文档。我有一个规则设置，可以将附加的文档保存到单个文件夹。为了最终实现自动化，我需要将文档保存到不同的文件夹中。到目前为止，我可以编辑两个文件的名称，但是当我尝试某种比较时，所以一个文件名在文件夹x中，另一个文件名到文件夹y，要么我在文件夹x中都得到，只出现一个从来没有，或者他们都被遗忘了。

这是我到目前为止所做的：

Public Sub saveAttachtoDiskRule(itm As Outlook.MailItem)

Dim objAtt As Outlook.Attachment
Dim saveFolder As String
Dim fso As Object
Dim oldName

Dim file As String
Dim DateFormat As String
Dim newName As String

Dim enviro As String
enviro = CStr(Environ("USERPROFILE"))
saveFolder = enviro & "\Desktop\SWR\"

Set fso = CreateObject("Scripting.FileSystemObject")
On Error Resume Next

 For Each objAtt In itm.Attachments


    '~> These two lines are where I run into trouble. 
    '~> Trying to change where I save the file. Only one at a time ever works.
    If InStr(objAtt.DisplayName, "Team") <> 0 Then saveFolder = saveFolder & "Productivity\"
    If InStr(objAtt.DisplayName, "Overdue") <> 0 Then saveFolder = saveFolder & "Overdue\"


    file = saveFolder & objAtt.DisplayName
    objAtt.SaveAsFile file

    Set oldName = fso.GetFile(file)

    '~> edits date to my specifications, works great
    DateFormat = Format(DateAdd("d", -3, oldName.DateLastModified), "mm-dd-yyyy ")
    '~> combines old name with date. Works great
    newName = DateFormat & objAtt.DisplayName

    oldName.Name = newName

    Set objAtt = Nothing
Next

    Set fso = Nothing
End Sub

Answer 1

只需使用if和Else命令，我还添加了新的 Dim SavePath As String ，因此代码不会与保存附件的位置混淆。

查看完整代码。

Option Explicit
Public Sub saveAttachtoDiskRule(itm As Outlook.MailItem)
    Dim objAtt As Outlook.Attachment
    Dim SaveFolder As String
    Dim SavePath As String
    Dim FSO As Object
    Dim oldName
    Dim file As String
    Dim DateFormat As String
    Dim newName As String
    Dim enviro As String

    enviro = CStr(Environ("USERPROFILE"))
    SaveFolder = enviro & "\Desktop\SWR\"

    Set FSO = CreateObject("Scripting.FileSystemObject")
'    On Error Resume Next

    For Each objAtt In itm.Attachments

        '~> These two lines are where I run into trouble.
        '~> Trying to change where I save the file. Only one at a time ever works.
'       If InStr(objAtt.DisplayName, "Team") <> 0 Then SaveFolder = SaveFolder & "Productivity\"
'       If InStr(objAtt.DisplayName, "Overdue") <> 0 Then SaveFolder = SaveFolder & "Overdue\"

        If InStr(objAtt.DisplayName, "Team.xlsx") Then
            SavePath = SaveFolder & "Productivity\"
        Else
            If InStr(objAtt.DisplayName, "Overdue.xlsx") Then
                SavePath = SaveFolder & "Overdue\"
            End If
        End If

        file = SavePath & objAtt.DisplayName

        objAtt.SaveAsFile file

        Set oldName = FSO.GetFile(file)

        '~> edits date to my specifications, works great
        DateFormat = Format(DateAdd("d", -3, oldName.DateLastModified), "mm-dd-yyyy ")
        '~> combines old name with date. Works great
        newName = DateFormat & objAtt.DisplayName

        oldName.Name = newName

    Next

    Set objAtt = Nothing
    Set FSO = Nothing
End Sub

带一封带有两个附件的电子邮件，并将每个附件保存到另一个文件夹中

1 个答案: