Ayuda con un archivo

Solo consultas sobre macros y código VBA Excel.
Reglas del Foro 1. Antes de hacer tu pregunta intenta con el buscador de este foro (muchas preguntas ya fueron respondidas antes!)
2. Si haces una nueva pregunta, es muy recomendable que adjuntes el ejemplo Excel para poder comprenderla mejor!
3. Realiza tu pregunta de forma clara, explicando bien cada paso de lo que haces y tendrás más probabilidad de respuesta!

Ayuda con un archivo

Notapor Martoooon » 04 Oct 2018 17:30

Estimados amigos del foro, buenas tardes.

Estoy necesitando ayuda para el envío de correos con diferente cantidades de adjuntos según la hoja activa, actualmente tengo un For que recorre las hojas y valida dependiendo la cantidad de archivos a adjuntar (se encuentra en la celda A5), pero al momento de querer realizar una modificación o que un cliente tenga mas cantidad de archivos a enviar es muy engorroso.

Existe alguna posibilidad de realizar un recorrido por pestañas y que adjunte la cantidad de archivos segun la hoja activa, todos los adjunto se listan a partir de la fila A8.

En total el archivo maneja 41 hojas de clientes, donde se obtiene la ruta donde listar los archivos, y cruces de asuntos y destinatarios.

Adjunto archivo y detallo macro utilizada para el envio de correo en outlook

Código: Seleccionar todo
Sub Mails30()
'base envio con firma
    Dim OutApp As Object
    Dim OutMail As Object
    Dim strbody As String
    Dim cell As Range
    Dim Asunto As String
    Dim correo As String
    Dim Copia As String
    Dim Mes As String
    Dim Msg As String
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
        Adjunto1 = Range("A8").Value
        Adjunto2 = Range("A9").Value
        adjunto3 = Range("A10").Value
        adjunto4 = Range("A11").Value
        adjunto5 = Range("A12").Value
        adjunto6 = Range("A13").Value
        adjunto7 = Range("A14").Value
        adjunto8 = Range("A15").Value
        adjunto9 = Range("A16").Value
        adjunto10 = Range("A17").Value
        adjunto11 = Range("A18").Value
        adjunto12 = Range("A19").Value
        adjunto13 = Range("A20").Value
        adjunto14 = Range("A21").Value
        adjunto15 = Range("A22").Value
        adjunto16 = Range("A23").Value
        adjunto17 = Range("A24").Value
        adjunto18 = Range("A25").Value
        adjunto19 = Range("A26").Value
        adjunto20 = Range("A27").Value
        adjunto21 = Range("A28").Value
        adjunto22 = Range("A29").Value
        adjunto23 = Range("A30").Value
        adjunto24 = Range("A31").Value
        adjunto25 = Range("A32").Value
        adjunto26 = Range("A33").Value
        adjunto27 = Range("A34").Value
        adjunto28 = Range("A35").Value
        adjunto29 = Range("A36").Value
        adjunto30 = Range("A37").Value
        correo = Range("B3").Value
        Asunto = Range("B5").Value
        Mes = Range("D1").Value
    strbody = "Estimados, buenos días.<br><br>" & _
              "Adjunto Facturas y Notas de crédito correspondientes al mes de " & Mes & " 2018, como así también adjunto el estado de cuenta.<br>" & _
              "Cualquier duda o consulta estoy a su disposición..<br>" & _
              "<br><br><B><H4>Les recordamos que los comprobantes de deposito y/o avisos de envio de cheques se deberan enviar a cobranzas@dikter.com.ar</H4></B>"
    On Error Resume Next
    With OutMail
        .Display
        .To = correo
        .CC = Copia
        .BCC = ""
        .Subject = Asunto & " - " & Mes & " 2018"
        .HTMLBody = strbody & .HTMLBody
        .Attachments.Add Adjunto1
        .Attachments.Add Adjunto2
        .Attachments.Add adjunto3
        .Attachments.Add adjunto4
        .Attachments.Add adjunto5
        .Attachments.Add adjunto6
        .Attachments.Add adjunto7
        .Attachments.Add adjunto8
        .Attachments.Add adjunto9
        .Attachments.Add adjunto10
        .Attachments.Add adjunto11
        .Attachments.Add adjunto12
        .Attachments.Add adjunto13
        .Attachments.Add adjunto14
        .Attachments.Add adjunto15
        .Attachments.Add adjunto16
        .Attachments.Add adjunto17
        .Attachments.Add adjunto18
        .Attachments.Add adjunto19
        .Attachments.Add adjunto20
        .Attachments.Add adjunto21
        .Attachments.Add adjunto22
        .Attachments.Add adjunto23
        .Attachments.Add adjunto24
        .Attachments.Add adjunto25
        .Attachments.Add adjunto26
        .Attachments.Add adjunto27
        .Attachments.Add adjunto28
        .Attachments.Add adjunto29
        .Attachments.Add adjunto30

        '.Send
    End With
    On Error GoTo 0
    Set OutMail = Nothing
    Set OutApp = Nothing
End Sub


De antemano, muchas gracias.
Saludos
No tiene los permisos requeridos para ver los archivos adjuntos a este mensaje.
Martoooon
Miembro Frecuente
Miembro Frecuente
 
Mensajes: 65
Registrado: 16 Sep 2014 21:52

Re: Ayuda con un archivo

Notapor Cacho R » 04 Oct 2018 18:32

.
Hola!
Comienza por "volar" todos esos Adjuntos y esos Attachments que tienes por allí y reemplázalos por lo que sigue:

Código: Seleccionar todo
Vec = ""
If [a8] <> "" Then
  If [a9] <> "" Then Vec = Range([a8], [a8].End(xlDown)) Else Vec = Array([a8].Value)
End If

With OutMail
  If Vec <> "" Then
    For Each iFile In Vec: .Attachments.Add iFile: Next
  End If
End With
Avatar de Usuario
Cacho R
Miembro Frecuente
Miembro Frecuente
 
Mensajes: 10481
Registrado: 23 Jun 2011 17:15
Ubicación: Buenos Aires

Re: Ayuda con un archivo

Notapor Martoooon » 05 Oct 2018 09:27

Cacho R escribió:.
Hola!
Comienza por "volar" todos esos Adjuntos y esos Attachments que tienes por allí y reemplázalos por lo que sigue:

Código: Seleccionar todo
Vec = ""
If [a8] <> "" Then
  If [a9] <> "" Then Vec = Range([a8], [a8].End(xlDown)) Else Vec = Array([a8].Value)
End If

With OutMail
  If Vec <> "" Then
    For Each iFile In Vec: .Attachments.Add iFile: Next
  End If
End With


Muchas gracias Cacho! con esta modificación no hace falta realizar el if para buscar la cantidad de adjuntos según la hoja no?. De ser así seria una modificación muy simple para la macro "gigante" que tengo.

Muchas gracias nuevamente!
Martoooon
Miembro Frecuente
Miembro Frecuente
 
Mensajes: 65
Registrado: 16 Sep 2014 21:52


Volver a Macros

¿Quién está conectado?

Usuarios navegando por este Foro: No hay usuarios registrados visitando el Foro y 4 invitados
cron