Iniciar sesiónCerrar
Correo:
Contraseña:
Entrar
Recordar sesión en este navegador
Iniciar sesiónIniciar sesiónCrear cuentaCrear cuenta
LWP » Foros » Excel » Problema envio adjuntos vba

Excel - Problema envio adjuntos vba

Volver
Nuevo Tema
<<>>
 
Vista:
sin imagen de perfil

Problema envio adjuntos vba

Publicado por Paco (4 intervenciones) el 10/11/2021 10:17:14
Hola, buenos dias.
Estoy preparando un libro de excel donde gestionar los gastos de una comunidad de viviendas en alquiler. Tengo varias hojas donde pongo los datos que necesito (lectura contadores, gastos de comunidad, basura...). He creado un botón con una macro para cada vivienda el cual envía los gastos relativos a esa vivienda en ese mes en concreto y ademas, adjunta los archivos necesarios.
Todo funciona bien, pero al pasar a la siguiente vivienda, me adjunta también los adjuntos de la anterior, y así sucesivamente.

Adjunto el archivo por si alguien me puede echar una mano.

Los botones que llaman a las macros están en la pestaña registro. El problema que tengo es que cuando clico en el primer botón, me adjunta correctamente los adjuntos, pero al clicar en el segundo, me adjunta los adjuntos del primero y del segundo. Es como si arrastrara los adjuntos anteriores y los añadiera también al segundo macro.

Muchas gracias de antemano.
Valora esta pregunta
Me gusta: Está pregunta es útil y esta claraNo me gusta: Está pregunta no esta clara o no es útil
0
Responder
Imágen de perfil de Antoni Masana
Val: 4.908
Oro
Ha mantenido su posición en Excel (en relación al último mes)
Gráfica de Excel

Problema envio adjuntos vba

Publicado por Antoni Masana (2540 intervenciones) el 10/11/2021 17:48:16
He estado revisando las macros y veo que repites muchas veces la misma macro, en realidad solo son 11 veces la misma macro, si en lugar de 11 fuesen 200 o 400 seria para volverse loco porque si detectas un fallo en una macro tienes que corregir 400 y es para acabar loco.

Empezare por las macros más simples:

MACRO Añadir

[indent]En lugar de repetir tantas veces el Copy+Paste utiliza un FOR i en lugar de Range utiliza Cells que puedes poner la fila y la columna con números[/indent]

MACRO PDF

[indent]Te pongo un trozo:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
Sub PDF()
    Ruta = "C:\Users\Paco\Documents\Alquileres\LUZ Inquilinos PDF\"
 
    Fecha_1 = Format(Range("h2"), "yyyy-mm ")
    Fecha_2 = Format(Date, "yyyy-mm ")
    Fecha_3 = Format(Worksheets("PDF Luz").Range("h2"), "yyyy-mm ")
 
    ' ---&--- Telegrafo 47 PB
 
    ActiveSheet.Range("A5:B21").Select
    Selection.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Ruta & "41 Planta Baja\" & Fecha_1 & Range("B7") & ".pdf", _
                                                   Quality:=xlQualityStandard, _
                                                   IncludeDocProperties:=True, _
                                                   IgnorePrintAreas:=False, _
                                                   OpenAfterPublish:=False
    Worksheets("Registro").Range("d19").Value = Ruta & "41 Planta Baja\" & Fecha_3 & Range("B7") & ".pdf"

Los textos marcados en negrita los pones en una tabla y un FOR exporta todos los PDF sin necesidad de estar repitiendo código[/indent]


Los procedimientos de Modulo 2 hay que hacer uno y pasarle los parámetros necesarios. Te marco que hay que pasarle:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
Sub EnviarTelegrafoPrimero()
    Dim Asunto As String
    Dim Correo As String
    Dim Destinatario As String
    Dim Msg As String
 
    Dim a As Worksheet
    Dim srang As Range
    Dim name As String
 
    Application.ScreenUpdating = False
    Application.EnableEvents = False
 
    Set a = Worksheets("provisional")
    Set srang = a.Range("a1:b10")                                   'define la hoja "provisional" y el rango que copiaremos al mail            '
 
    Range("e5:e14").Copy                                            'copia la columna requerida a la pagina "provisional"
    Sheets("provisional").Range("B1").PasteSpecial xlPasteValues    'pega la columna en "provisional"
 
    Asunto = Worksheets("Registro").Range("c2").Value               'Dejar igual. Pone como asunto del mail el mes a facturar
    Destinatario = Worksheets("Datos").Range("g3").Value            'Cambiar Nombre Inquilino
    Correo = Worksheets("Datos").Range("f15").Value                 'mi correo para pruebas. Cambiar por el correo del inquilino
 
    'Cuerpo del mensaje
    '
    Msg = "Hola " & Destinatario & vbNewLine & vbNewLine
    Msg = Msg & "aquí tienes las cuentas del mes de "
    Msg = Msg & Worksheets("Registro").Range("c2").Value & "." & vbNewLine & vbNewLine
    Msg = Msg & "¡Saludos!"                                     'Define el mensaje de texto que irá en el cuerpo del mail
 
    With srang
        .Parent.Select
        .Select
        ActiveWorkbook.EnvelopeVisible = True
        With .Parent.MailEnvelope
             .Introduction = Msg
 
             With .Item
                 .To = Correo
                 .Subject = "Mes de " & Asunto
                 .BCC = "pacoma76@gmail.com"
 
                 'adjuntos
 
                 If Not IsEmpty(Worksheets("Registro").Range("e16").Value) Then
                     .Attachments.Add "C:\Users\Paco\Documents\Alquileres\" & Worksheets("Registro").Range("e16").Value
                 End If
 
                 If Not IsEmpty(Worksheets("Registro").Range("e17").Value) Then
                     .Attachments.Add "C:\Users\Paco\Documents\Alquileres\" & Worksheets("Registro").Range("e17").Value
                 End If
 
                 If Not IsEmpty(Worksheets("Registro").Range("e18").Value) Then
                     .Attachments.Add "C:\Users\Paco\Documents\Alquileres\" & Worksheets("Registro").Range("e18").Value
                 End If
 
                 If Not IsEmpty(Worksheets("Registro").Range("e19").Value) Then
                     .Attachments.Add Worksheets("Registro").Range("e19").Value
                 End If
 
                 'Worksheets("Registro").Range("d19").Value = "Enviado"
                 '.Send                         'Enviar directamente el correo
             End With
        End With
    End With
   'ActiveWorkbook.EnvelopeVisible = False
    Application.ScreenUpdating = False
    Application.EnableEvents = False
End Sub

La macro deberia ser asi:


1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
Sub TelegrafoPrimero()
    Call Enviar("e5:e14", "G3", "E", "D19")
End Sub
 
Sub Enviar(Rango, Desti, PDF, Ok_Envio)
    Dim Asunto As String
    Dim Correo As String
    Dim Destinatario As String
    Dim Msg As String
 
    Dim a As Worksheet
    Dim srang As Range
    Dim name As String
 
    Application.ScreenUpdating = False
    Application.EnableEvents = False
 
    Set a = Worksheets("provisional")
    Set srang = a.Range(Rango)                                   'define la hoja "provisional" y el rango que copiaremos al mail            '
 
    Range(Rango).Copy                                            'copia la columna requerida a la pagina "provisional"
    Sheets("provisional").Range("B1").PasteSpecial xlPasteValues    'pega la columna en "provisional"
 
    Asunto = Worksheets("Registro").Range("c2").Value               'Dejar igual. Pone como asunto del mail el mes a facturar
    Destinatario = Worksheets("Datos").Range(Desti).Value            'Cambiar Nombre Inquilino
    Correo = Worksheets("Datos").Range("f15").Value                 'mi correo para pruebas. Cambiar por el correo del inquilino
 
    'Cuerpo del mensaje
    '
    Msg = "Hola " & Destinatario & vbNewLine & vbNewLine
    Msg = Msg & "aquí tienes las cuentas del mes de "
    Msg = Msg & Worksheets("Registro").Range("c2").Value & "." & vbNewLine & vbNewLine
    Msg = Msg & "¡Saludos!"                                     'Define el mensaje de texto que irá en el cuerpo del mail
 
    With srang
        .Parent.Select
        .Select
        ActiveWorkbook.EnvelopeVisible = True
        With .Parent.MailEnvelope
             .Introduction = Msg
 
             With .Item
                 .To = Correo
                 .Subject = "Mes de " & Asunto
                 .BCC = "pacoma76@gmail.com"
 
                 'adjuntos
 
                 For Fila=16 to 19
                     If Not IsEmpty(Worksheets("Registro").Range(PDF & Fila).Value) Then
                         .Attachments.Add "C:\Users\Paco\Documents\Alquileres\" & Worksheets("Registro").Range(PDF & Fila).Value
                     End If
                 Next
 
                 'Worksheets("Registro").Range(Ok_Envio).Value = "Enviado"
                 '.Send                         'Enviar directamente el correo
             End With
        End With
    End With
   'ActiveWorkbook.EnvelopeVisible = False
    Application.ScreenUpdating = False
    Application.EnableEvents = False
End Sub

Y ahora una pregunta ¿los adjunto están dentro o fuera del With .Item? Porque en una macro esta dentro y en otra fuera.

Vale esta no es la respuesta que esperabas pero simplificando el código es más fácil encontrar los errores.

Saludos.
\\//_
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
1
Comentar
sin imagen de perfil

Problema envio adjuntos vba

Publicado por Paco (4 intervenciones) el 10/11/2021 18:31:18
Hola Antoni,
primero, muchisimas gracias por dedicar tu tiempo a revisar el codigo. Intentaré modificar el codigo siguiendo las recomendaciones que me das. Tardaré bastante, porque no tengo mucha idea de programación, como puedes ver. Pero seguro que son buenos consejos.

Respecto a la pregunta si los adjuntos estan dentro o fuera del with.item...pues deberian estar igual en todas las macros, pero como he ido cambiando cosas para buscar la solución, supongo que se me pasaría por alto.

Lo revisaré.

Muchas gracias, ya tengo faena!!

Saludos!
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
0
Comentar