Enviar rango de celdas por correo O365

[Pirtrafilla]

Hola a todos. De nuevo por aquí pidiendo ayuda.

Nos han cambiado las licencias de Office a Office 365. He revisado las macros y las que me fallan tienen que ver con las que envío correos automatizados. He podido arreglar todas, cambiando el código porque de Office 2013 a Office 365 cambia el código, se usa el objeto CDO.Message. Pero se me resiste esta macro, que envía un correo e incluye como parte del cuerpo del correo un rango de celdas donde hay un gráfico. Os pego el código para ver si me podéis ayudar. Después de la instrucción "ActiveWorkbook.EnvelopeVisible = True" el programa ya no ejecuta nada más. He probado con F8 paso a paso y ahí se detiene.

Necesito que el cuerpo del correo inserte las celdas  A2:T49 de la hoja "Tablero". 

Si veis que así no se me entiende puedo crear un archivo y pegar la macro, pero como el código no es muy largo lo he puesto así.

 

Sub EnviarTableroInsertado()
ApplicationOff

'variables
Dim iMsg As Object, iConf As Object
Dim cuerpo As String, schema As String, spie As String, mail As String
Dim Flds As Variant

Set iMsg = CreateObject("CDO.Message"): Set iConf = CreateObject("CDO.Configuration")

iConf.Load -1
Set Flds = iConf.Fields
schema = "http://schemas.microsoft.com/cdo/configuration/"

 With Flds
            Flds.Item(schema & "sendusing") = 2
            Flds.Item(schema & "smtpserver") = "smtp.office365.com"
            Flds.Item(schema & "smtpserverport") = 25
            Flds.Item(schema & "smtpauthenticate") = 1
            Flds.Item(schema & "sendusername") = "micorreo"
            Flds.Item(schema & "sendpassword") = "micontraseña"
            Flds.Item(schema & "smtpusessl") = True
            Flds.Update
 End With

Set tb = Sheets("Tablero")
     tb.Select
     mail = tb.Range("Y2")
     tb.Range("A2:T49").Select
     '
     ActiveWorkbook.EnvelopeVisible = True
     ' 
     With iMsg
      Set .Configuration = iConf
      .From = "micorreo"
      With ActiveSheet.MailEnvelope
       .Item.Subject = "Produccion Tablero - Personal Propio I+M - " & tb.Range("M2")
       .Item.To = mail
       '.Item.CC = ""
       '.Item.Introduction = "Adjuntamos Produccion Tablero - Personal Propio I+M -" & tb.Range("M2")
       .Item.Send
      End With
     End With
      Sheets("TOTAL").Select
   Set iMsg = Nothing:    Set iConf = Nothing:    Set Flds = Nothing
   Set tb = Nothing
  '
ApplicationOn
End Sub

Gracias.

Moisés.

[Pirtrafilla]

Hola a todos. Envío un fichero de muestra, a ver si podéis ayudarme.

Con O365 no encuentro la misma información que las versiones convencionales.

Tengo O365 con aplicaciones en escritorio.

 

Gracias.

Moisés.

EnviarCorreoRangoCeldas.xlsm

[Pirtrafilla]

Hola a todos, no me ha podido ayudar nadie de momento.

Entiendo que el Office 365 es un poco reciente y no hay tanta información. De todos modos he conseguido que la empresa me ponga el Outlook en escritorio y me vuelve a funcionar con los códigos que ya tenía, pero si a alguien se le ocurre como hacer lo que solicito ayuda os lo agradezco, seguro que será útil.

Gracias de todos modos, un abrazo.

Moisés.