excel vba adjuntar archivo al correo electrónico y enviar ejemplo de código

Luego de de una larga búsqueda de información solucionamos esta traba que tienen muchos de nuestros usuarios. Te compartimos la respuesta y nuestro objetivo es servirte de gran apoyo.

Ejemplo 1: obtener el archivo de Excel del archivo adjunto de correo electrónico en vba

Sub SaveEmailAttachmentsToFolder(OutlookFolderInInbox AsString,_
                                 ExtString AsString, DestFolder AsString)Dim ns AsNamespaceDim Inbox As MAPIFolder
    Dim SubFolder As MAPIFolder
    Dim Item AsObjectDim Atmt As Attachment
    Dim FileName AsStringDim MyDocPath AsStringDim I AsIntegerDim wsh AsObjectDim fs AsObjectOnErrorGoTo ThisMacro_err

    Set ns = GetNamespace("MAPI")Set Inbox = ns.GetDefaultFolder(olFolderInbox)Set SubFolder = Inbox.Folders(OutlookFolderInInbox)

    I =0' Check subfolder for messages and exit of none foundIf SubFolder.Items.Count =0Then
        MsgBox "There are no messages in this folder : "& OutlookFolderInInbox,_
               vbInformation,"Nothing Found"Set SubFolder =NothingSet Inbox =NothingSet ns =NothingExitSubEndIf'Create DestFolder if DestFolder = ""If DestFolder =""ThenSet wsh = CreateObject("WScript.Shell")Set fs = CreateObject("Scripting.FileSystemObject")
        MyDocPath = wsh.SpecialFolders.Item("mydocuments")
        DestFolder = MyDocPath &""& Format(Now,"dd-mmm-yyyy hh-mm-ss")IfNot fs.FolderExists(DestFolder)Then
            fs.CreateFolder DestFolder
        EndIfEndIfIf Right(DestFolder,1)<>""Then
        DestFolder = DestFolder &""EndIf' Check each message for attachments and extensionsForEach Item In SubFolder.Items
        ForEach Atmt In Item.Attachments
            If LCase(Right(Atmt.FileName, Len(ExtString)))= LCase(ExtString)Then
                FileName = DestFolder & Item.SenderName &" "& Atmt.FileName
                Atmt.SaveAsFile FileName
                I = I +1EndIfNext Atmt
    Next Item

    ' Show this message when FinishedIf I >0Then
        MsgBox "You can find the files here : "_& DestFolder, vbInformation,"Finished!"Else
        MsgBox "No attached files in your mail.", vbInformation,"Finished!"EndIf' Clear memory
ThisMacro_exit:Set SubFolder =NothingSet Inbox =NothingSet ns =NothingSet fs =NothingSet wsh =NothingExitSub' Error information
ThisMacro_err:
    MsgBox "An unexpected error has occurred."_& vbCrLf &"Please note and report the following information."_& vbCrLf &"Macro Name: SaveEmailAttachmentsToFolder"_& vbCrLf &"Error Number: "& Err.Number _& vbCrLf &"Error Description: "& Err.Description _, vbCritical,"Error!"Resume ThisMacro_exit

EndSub

Ejemplo 2: obtener el archivo de Excel del archivo adjunto de correo electrónico en vba

Sub Test()'Arg 1 = Folder name of folder inside your Inbox'Arg 2 = File extension, "" is every file'Arg 3 = Save folder, "C:UsersRontest" or ""'        If you use "" it will create a date/time stamped folder for you in your "Documents" folder'        Note: If you use this "C:UsersRontest" the folder must exist.

    SaveEmailAttachmentsToFolder "MyFolder","xls",""EndSub

Finalizando este artículo puedes encontrar las acotaciones de otros administradores, tú aún tienes el poder insertar el tuyo si dominas el tema.

---

---

Utiliza Nuestro Buscador