Сохранить электронные письма в ежедневных папках

Question

Я пытаюсь создать макрос, который будет сохранять электронные письма в папку, созданную локально на моем жестком диске. Папка создается ежедневно через пакетный файл, который был написан. Формат имени папки будет mm-dd-yyyy. Моя цель - сохранить все электронные письма, которые появляются каждый день, в соответствующие папки. Например, все электронные письма, которые приходят сегодня, сохраняются в папке с именем 05-07-2015. Вот код, который у меня есть.

Public Sub SaveMsgs(Item As Outlook.MailItem) 
    Dim sPath As String 
    Dim dtDate As Date 
    Dim sName As String 
    Dim enviro As String 
    Dim sSender As String 
    Dim strFolder As String 
    Dim strNewFolder As String 
    Dim save_to_folder As String 

    enviro = CStr(Environ("USERPROFILE")) 

    sName = Item.Subject 
    ReplaceCharsForFileName sName, "_" 

    sSender = Item.Sender 

    dtDate = Item.ReceivedTime 
    sName = sSender & " - " & sName & ".msg" 

    strNewFolder = Format(Date, "mm-dd-yyyy ") 
    strFolder = "C:\IT Documents\" & daymonthyr & strNewFolder 

    If Len(Dir(strFolder, vbDirectory)) = 0 Then 
    MkDir (strFolder) 
    End If 

    save_to_folder = strFolder 


    'FolderCreate = "C:\IT Documents\" & Format(Now, "mm-dd-yyyy ") & "\" 

    'If Not FSO.FolderExists(FolderCreate) Then 
    'FSO.CreateFolder (FolderCreate) 
    'End If 

'set the destination path 
' sPath = "C:\IT Documents\" & Format(Now, "mm-dd-yyyy ") & "\" 
    For Each Item In Outlook.ActiveExplorer.Selection 

    Debug.Print sName 
    Item.SaveAs save_to_folder & sName 

    Next 

    Set Item = Nothing 

End Sub 

Private Sub ReplaceCharsForFileName(sName As String, _ 
    sChr As String _ 
) 
sName = Replace(sName, "/", sChr) 
sName = Replace(sName, "\", sChr) 
sName = Replace(sName, ":", sChr) 
sName = Replace(sName, "?", sChr) 
sName = Replace(sName, Chr(34), sChr) 
sName = Replace(sName, "<", sChr) 
sName = Replace(sName, ">", sChr) 
sName = Replace(sName, "|", sChr) 
End Sub 

Пока сценарий почти работает так, как предполагается. Электронные письма сохраняются в папке ИТ-документов, но они не сохраняются в соответствующей ежедневной папке. Какие изменения необходимо будет внести. Сейчас я не уверен, что мне придется изменить. Благодарим вас за помощь.

Answer 1

Кажется, что вам не хватает тире между именем файла и последней папкой.

После добавления & "\" позади strFolder = "C:\IT Documents\" & daymonthyr & strNewFolder он работает для меня.