SAVE EMAILS WITH A PATH FROM AN EXCEL CELL

Question

SAVE EMAILS WITH A PATH FROM AN EXCEL CELL

Modesto Gonzalez Chavez 20

SAVE EMAILS WITH A PATH FROM AN EXCEL CELL

Answer accepted by question author

0 additional answers

Your answer

Answer 1

Claudia Dos Santos Haz (CONCENTRIX CORPORATION) 1,145 Microsoft External Staff

Hi @Modesto Gonzalez Chavez ,

To save email with path from an excel cell try to:

Open Outlook and click on "File".
Select "Open and Export" or "Open" depending on your version of Outlook.
Click on "Import/Export".
Choose "Export to a file", then select "Microsoft Excel" or "Comma Separated Values".
Choose the email folder from which you want to export messages.
Browse to the folder where you want to save the file or copy the path you want and click "Finish".

Best regards,

Modesto Gonzalez Chavez 20

Thank you very much Claudia, I just forgot to mention that I would use macros, I attach my code for 2 actions.

searching for the data
extract the data

But the detail is that I cannot manage to combine the 2 actions.

Sub BuscarEnOutlook()
    Dim OutlookApp As Object
    Dim OutlookNamespace As Object
    Dim OutlookExplorer As Object
    Dim ValorBusqueda As String
    
    ' Establecer el valor de búsqueda como el contenido de la celda A1
    ValorBusqueda = Sheets("Hoja1").Range("A1").Value
    
    ' Crear una instancia de Outlook
    On Error Resume Next
    Set OutlookApp = GetObject(, "Outlook.Application")
    On Error GoTo 0
    
    If OutlookApp Is Nothing Then
        Set OutlookApp = CreateObject("Outlook.Application")
    End If
    
    ' Obtener el objeto de espacio de nombres de Outlook
    Set OutlookNamespace = OutlookApp.GetNamespace("MAPI")
    
    ' Obtener el explorador de Outlook
    Set OutlookExplorer = OutlookApp.ActiveExplorer
    
    ' Limpiar cualquier búsqueda existente
    OutlookExplorer.ClearSearch
    
    ' Realizar la búsqueda
    OutlookExplorer.Search ValorBusqueda, olSearchScopeAllFolders
    
    ' Mostrar la ventana de búsqueda
    OutlookExplorer.Display
End Sub

Public Sub SaveAttachmentsOfSelectedEmails()

    Dim App As New Outlook.Application
    Dim Exp As Outlook.Explorer
    Dim Sel As Outlook.Selection
    Dim objShell As Object
    Dim AttachmentCnt As Integer
    Dim AttTotal As Integer
    Dim MsgTotal As Integer
    Dim strSaveFldr As String
    
    ' Obtener la ruta de la carpeta desde la celda A2
    strSaveFldr = ThisWorkbook.Sheets("Hoja1").Range("A2").Value
    
    ' Validar que la carpeta existe
    If Dir(strSaveFldr, vbDirectory) = "" Then
        MsgBox "La carpeta especificada no existe.", vbExclamation
        Exit Sub
    End If

    Set Exp = App.ActiveExplorer
    Set Sel = Exp.Selection

    ' Loop a través de cada elemento seleccionado en la bandeja de entrada
    For cnt = 1 To Sel.Count
        ' Si el correo electrónico tiene archivos adjuntos...
        If Sel.Item(cnt).Attachments.Count > 0 Then
            MsgTotal = MsgTotal + 1
            AttTotal = AttTotal + Sel.Item(cnt).Attachments.Count
            
            ' Para cada archivo adjunto en el mensaje...
            For AttachmentCnt = 1 To Sel.Item(cnt).Attachments.Count
                ' Obtener el archivo adjunto
                Dim att As Attachment
                Set att = Sel.Item(cnt).Attachments.Item(AttachmentCnt)
                ' Guardarlo en disco
                att.SaveAsFile (strSaveFldr & "\" & att.Filename)
            Next
        End If
    Next

    ' Limpiar
    Set Sel = Nothing
    Set Exp = Nothing
    Set App = Nothing

    ' Informar al usuario que hemos terminado
    MsgBox "Proceso completado.", vbInformation

End Sub

Share via

SAVE EMAILS WITH A PATH FROM AN EXCEL CELL

0 additional answers

Your answer