Guardar adjuntos de correos "archivos .msg" en carpeta

[luis ayala]

Buen dia

Deseo me ayude alguien con una macro siguiente:

Deseo que me guarde los adjuntos de un correo de outlook guardado en una carpeta (archivos .msg en carpeta en mi pc) y los guarde en otra carpeta sus archivos adjuntos (pdf y XML), sin tener que estar abriendo uno por uno.

Agradezco su ayuda, ya que me marca el siguiente error "User-Defined type not defined" y no entiendo porque.

Sub SaveMSGAttachments()

Dim olItem As MailItem

Dim SH As Object

Dim msgFolder

Dim saveFolder

Dim strFilesFldr As String

Dim strSaveFldr As String

Dim objAtt As Outlook.Attachment

Dim strFilename As String

On Error GoTo Cleanup

Set SH = CreateObject("SHell.Application")

Set msgFolder = SH.BrowseForFolder(0, "Selecciona el Folder que Contiene los .msg", &H400)

If msgFolder Is Nothing Then Exit Sub

strFilesFldr = msgFolder.Items.Item.Path & "\"

Set saveFolder = SH.BrowseForFolder(0, "Selecciona el Folder para Guardar los Adjuntos", &H400)

If saveFolder Is Nothing Then Exit Sub

strSaveFldr = saveFolder.Items.Item.Path & "\"

strFilename = Dir$(strFilesFldr & "*.msg")

While Len(strFilename) <> 0

    Set olItem = Application.CreateItemFromTemplate(strFilesFldr & strFilename)

    If olItem.Attachments.Count > 0 Then

        For Each objAtt In olItem.Attachments

            objAtt.SaveAsFile strSaveFldr & Format(Now, "yyyymmdd-HHMMSS") & Chr(32) & objAtt.Filename

        Next objAtt

    End If

    olItem.Delete

    strFilename = Dir$()

Wend

Cleanup:

Set msgFolder = Nothing

Set saveFolder = Nothing

Set SH = Nothing

Set objAtt = Nothing

Set olItem = Nothing

End Sub

[/CODE]