ERROR 1004 EN TIEMPO DE EJECUCIÓN AL GUARDAR UN DOCUMENTO, AYUDA PORFAVOR !
Publicado por Andrés (6 intervenciones) el 19/02/2016 15:55:38
LA MACRO ES PARA ENVIAR EL EXCEL CON FORMATO PDF, LO QUE PASA ES QUE SI FUNCIONA, PERO A VECES ME ARROJA ESE ERROR ( EN REALIDAD LA MAYORÍA DE VECES OCURRE ESTO) DESDE YA GRACIAS POR SU TIEMPO Y AYUDA
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
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
Public nombre10 As String
Public nombre20 As String
Sub archivo10()
Cells(6, 2) = Format(Now, "ddmmyyhhmmss")
Cells(11, 11) = Format(Now, "dd/mm/yy ")
nombrePL1 = "PACKING LIST CLIENTE" & ", OC N° " & Cells(8, 5) & ", " & " NOTA DE DESPACHO N° " & Cells(8, 8) 'Nombre para el archivo
Range("A1:J37").Select 'rango inicio y final selecionado
Selection.ExportAsFixedFormat Type:=xlTypePDF, Filename:="C:\Users\NMoraga\Desktop\DESPACHO_FILM\Packing List\Packing List Cliente\" & nombrePL1, _
Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
openAfterPublish:=True 'Si quieres que el archivo se abra luego de creado, cambia False por True al final
nombre10 = "C:\Users\NMoraga\Desktop\DESPACHO_FILM\Packing List\Packing List Cliente\" & nombrePL1 & ".pdf"
nombrePL2 = "PACKING LIST REVISIÓN" & ", OC N° " & Cells(8, 5) & ", " & " NOTA DE DESPACHO N° " & Cells(8, 8) 'Nombre para el archivo
Range("A1:K39").Select 'rango inicio y final selecionado
Selection.ExportAsFixedFormat Type:=xlTypePDF, Filename:="C:\Users\NMoraga\Desktop\DESPACHO_FILM\Packing List\" & nombrePL2, _
Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
openAfterPublish:=False 'Si quieres que el archivo se abra luego de creado, cambia False por True al final
nombre20 = "C:\Users\NMoraga\Desktop\DESPACHO_FILM\Packing List\" & nombrePL2 & ".pdf"
Dim MailExitosoPL As Boolean
MailExitosoPL = EnviarMails_CDOPL()
If MailExitosoPL = True Then
MsgBox "El mail fué enviado satisfactoriamente", vbInformation, "Informe"
End If
End Sub
Function EnviarMails_CDOPL() As Boolean
' Creo la variable de objeto CDO
Dim EmailPL As CDO.Message
Dim AutentificionPL As Boolean
' ahora doy vida al objeto
Set EmailPL = New CDO.Message
'indicamos los datos del servidor:
EmailPL.Configuration.Fields(cdoSMTPServer) = "smtp.gmail.com"
EmailPL.Configuration.Fields(cdoSendUsingMethod) = 2
'indicamos el nro de puerto. por defecto es el 25, pero gmail usa el 465. hay otro
'(que ahora no recuerdo) pero no me funcionaba... por eso no lo usé mas y lo olvidé
EmailPL.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = CLng(465)
'aqui dejamos en claro si el servidor que usamos requiere o nó autentificación.
'1=requiere, 0=no requiere. Para gmail, entonces, 1
EmailPL.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/" & _
"configuration/smtpauthenticate") = Abs(1)
'segundos para el tiempo maximo de espera. aconsejo no modificarlo:
EmailPL.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 30
'aqui defino como True (verdadera) a la autentificación para el envío de mails.
AutentificacionPL = True
'ahora configuramos las opciones de login de gmail:
If AutentificacionPL Then
'nombre de usuario
EmailPL.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/sendusername") = ""
'contraseña
EmailPL.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/sendpassword") = ""
'si el servidor utiliza SSL (secure socket layer). en gmail: True
EmailPL.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
End If
'a partir de ahora tomaremos los datos incluidos en el la hoja de excel:
' Dirección del Destinatario
EmailPL.To = ""
' Dirección del remitente
EmailPL.From = ""
' Asunto del mensaje
EmailPL.Subject = "PACKING LIST," & " NOTA DE DESPACHO N° " & Cells(8, 8)
' Cuerpo del mensaje
EmailPL.TextBody = "PACKING LIST " & ", OC N° " & Cells(8, 5) & ", " & " NOTA DE DESPACHO N° " & Cells(8, 8)
'Ruta del archivo adjunto
EmailPL.AddAttachment (nombre10)
EmailPL.AddAttachment (nombre20)
'antes de enviar actualizamos los datos:
EmailPL.Configuration.Fields.Update
'colocamos un capturador de errores, por las dudas:
On Error Resume Next
'enviamos el mail
EmailPL.Send
'si el numero de error es 0 (o sea, no existieron errores en el proceso),
'hago que la función retorne Verdadero
If Err.Number = 0 Then
EnviarMails_CDOPL = True
Else
'caso contrario, muestro un MsgBox con la descripcion y nro de error
MsgBox "Se produjo el siguiente error: " & Err.Description, vbCritical, "Error nro " & Err.Number
End If
'destruyo el objeto, para liberar los recursos del sistema
If Not EmailPL Is Nothing Then
Set EmailPL = Nothing
End If
'libero posibles errores
On Error GoTo 0
End Function
Valora esta pregunta
0