none
Seleccionar cuenta no predeterminada con macro RRS feed

  • Pregunta

  • Buenos días a todos

    Les escribo porque estoy haciendo una macro en excel que descarga los adjuntos.

    La macro se conecta a outlook y descarga los adjuntos de un correo en concreto que llega todos los días y lo almacena en un carpeta de mi PC. Hasta ahora he consegudo que funcione todo sin problemas.

    El lio viene porque en outlook tengo dos cuentas configuradas. Y la macro solo se me conecta a la que esta establecida como principal.

    Por la tanto, ¿Sabría alguien como seleccionar una cuanta de correo no predeterminada para poder trabajar con ella?

    Sub SaveAttachments()
    
    Dim objOutlook As Object
    Dim objMAPI As Object
    Dim Item As Object
    Dim Attach As Object
    Dim myFolder As Object
    
    'Abrir Outlook
    Set objOutlook = CreateObject("Outlook.Application")
    
    'Iniciar sesión MAPI
    Set objMAPI = objOutlook.GetNamespace("MAPI")
    objMAPI.Logon , , False, False
    
    
    'Obtener la carpeta de mensajes
    Set myFolder = objMAPI.GetDefaultFolder(6) '6=olFolderInbox
    
    With myFolder.Folders("Juan") 'subcarpeta
    
    'Recorrer los elementos de la carpeta
    Dim NMail, cont As Integer
    NMail = .Items.Count: cont = 0 'igulamaos NMail al numero de correos para poder empezar a recorrer los correos desde el ultimo recibido
    
    Application.Goto (ActiveWorkbook.Sheets("No Borrar").Range("a1"))
    Do While cont < 2
        Set Item = .Items(NMail) ' igualamos el ultimo correo recibido al objeto item
            [D2] = .Items(NMail)
            [C2] = NMail
            If ([H2] = [D2] Or [H3] = [D2]) Then ' si el correo que se examina tiene el mismo nombre que se indica en la macro es que es uno de los correos que queremos archivar
    
                If ([H2] = [D2]) Then  'en este comando guardamos los correos de CWIS
                    For Each Attach In Item.Attachments
                        [E2] = Attach.DisplayName
                        Attach.SaveAsFile [I2] + [J2] 'guardamos el archivo en la carpeta correspondiente
                        If Attach = [E2] Then Exit For 'linea extra, La macro entiende que una imagen añadida en el correo es un adjunto, luego si no ponemos esta linea la macro guarda tambien esa imangen en la carpeta, y por como está definida la macro sobreescribe
                    Next
                    [D2].ClearContents
                    cont = cont + 1
                End If
                
                If ([H3] = [D2]) Then 'en este comando guardamos los correos de SIPS
                    For Each Attach In Item.Attachments
                        [E2] = Attach.DisplayName
                        Attach.SaveAsFile [I3] + [J3] 'guardamos el archivo en la carpeta correspondiente
                        If Attach = [E2] Then Exit For  'linea extra
                    Next
                    [D2].ClearContents
                    cont = cont + 1
                End If
            
            End If
            
        NMail = NMail - 1
    Loop
    End With
    
    
    End Sub

    Esta es la macro completa por si a alguien le interesa.

    el porblema creo que está al principio, en:

    Set objMAPI = objOutlook.GetNamespace("MAPI")
    objMAPI.Logon , , False, False

    Muchas gracias

    • Cambiado Moderador M lunes, 15 de junio de 2015 16:53
    viernes, 12 de junio de 2015 9:11