☰

Outlook VBA: crea automáticamente una carpeta según la fecha

tag-icon • tag-icon microsoft-outlook vba microsoft-outlook-2016
Outlook VBA: crea automáticamente una carpeta según la fecha

He creado un script VBA que guardará automáticamente los archivos adjuntos en formato PDF. ¿Alguien aquí sabe cómo puedo guardar el archivo adjunto según la fecha? Por ejemplo, hoy es 04-02-2020, entonces este usuario específico me envió un correo electrónico con un archivo PDF adjunto y automáticamente se creará una carpeta con el nombre 04-02-2020 y todo el correo de ese día se almacenará en esa carpeta. Luego, al día siguiente, se creará otra carpeta. Realmente necesito separar los archivos adjuntos entrantes por fecha.

Esto es lo que tengo hasta ahora

Public Sub saveAttachtoDisk(itm As Outlook.MailItem)
Dim dateFormat
dateFormat = Format(Now, "yyyy-mm-dd H-mm")
Dim objAtt As Outlook.Attachment
Dim saveFolder As String
Dim getsender As String
saveFolder = "C:\Users\UserName\Desktop\Attachments\"
     For Each objAtt In itm.Attachments
          If InStr(objAtt.FileName, ".pdf") > 0 Then
          objAtt.SaveAsFile saveFolder & "\" & dateFormat & objAtt.DisplayName
          Set objAtt = Nothing
          End If
     Next
End Sub

Respuesta1

Alguien en codeproject.com me ayudó a resolver mi problema y me gustaría agradecer a esa persona que tiene el nombre de usuario @CHill60. Muchas gracias por ayudarme. El siguiente código es de esa persona y ese código resolvió mi problema.

Aquí hay un enlace de mi pregunta publicada en codeproject.com [https://www.codeproject.com/Questions/5258321/Outlook-VBA-automatically-create-a-folder-based-on][1]

Aquí está el código completo publicado por @CHill60. Espero que esto pueda ser útil para otros.

Public Sub saveAttachtoDisk(itm As Outlook.MailItem)
    Dim dateFormat As String
    dateFormat = Format(itm.CreationTime, "mm-dd-yyyy")

    Dim objAtt As Outlook.Attachment
    Dim saveFolder As String
    Dim getsender As String

    saveFolder = "C:\Users\Username\Desktop\DLFolder\" & dateFormat & "\"

    CreateFolderIfNotExists saveFolder

    For Each objAtt In itm.Attachments
        If InStr(objAtt.FileName, ".pdf") > 0 Then
            objAtt.SaveAsFile saveFolder & objAtt.DisplayName
        End If

     Next
End Sub


Public Sub CreateFolderIfNotExists(folderName As String)
    Dim fs As Object
    Set fs = CreateObject("Scripting.FileSystemObject")

    If Not fs.folderexists(folderName) Then
        fs.createfolder (folderName)
    End If
End Sub

información relacionada