Error 13 en tiempo de ejecución
Publicado por Gustavo (2 intervenciones) el 11/04/2017 15:12:50
Hola todos : lo primero que comento es que no soy programador. Me regalaron un archivo de excel con una macro que envía correos electrónicos a cada contacto, adjuntando su respectivo archivo. De este archivo de excel hice copias cambiando los destinatarios de correo y la carpeta donde se encuentran los archivos a enviar. Lo curioso es que casi todos los archivos con su respectiva macro funcionan y envían el correo, pero en otros se produce el "error 13 en tiempo de ejecución". Repito NO SOY PROGRAMADOR, y por lo tanto no sé qué hacer. Alguien me puede ayudar ? Transcribo la macro señalando donde se produce el error :
De antemano muchas gracias si me ayudan con la macro. Cordial saludo
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
Sub Send_Files()
Dim OutApp As Outlook.Application Dim OutMail As Outlook.MailItemDim sh As Worksheet
Dim cell As Range
Dim FileCell As Range
Dim rng As Range
With Application
.EnableEvents = False
.ScreenUpdating = False
End With
Set sh = Sheets("Aptos")
Set OutApp = CreateObject("Outlook.Application")
For Each cell In sh.Columns("B").Cells.SpecialCells(xlCellTypeConstants)
'Enter the path/file names in the C:Z column in each row
Set rng = sh.Cells(cell.Row, 1).Range("C1:Z1")
If cell.Value Like "?*@?*.?*" And _
Application.WorksheetFunction.CountA(rng) > 0 Then
Set OutMail = OutApp.CreateItem(olMailItem)
With OutMail
.To = cell.Value
.Subject = "Factura de Administración"
.Body = "Buenas tardes : Adjunto estamos enviando la factura de Administración del mes en curso del Apartamento " & cell.Offset(0, -1).Value
For Each FileCell In rng.SpecialCells(xlCellTypeConstants)
If Trim(FileCell) <> "" Then
(En la siguiente línea es donde se produce el error ‘13’ en tiempo de ejecución, no coinciden los tipos)
If Dir(FileCell.Value) <> "" Then
.Attachments.Add FileCell.Value
End If
End If
Next FileCell
.Display 'Or use .Display
End With
Set OutMail = NothingEnd If
Next cell
Set OutApp = NothingWith Application
.EnableEvents = True
.ScreenUpdating = True
End With
End Sub
De antemano muchas gracias si me ayudan con la macro. Cordial saludo
Valora esta pregunta
0