Renombrar archivos xml y enviar por email desde excel
Quisiera me apoyaran para hacer un macros que renombre archivos .xml por otros datos en celdas y enviar por email desde excel.
1 Respuesta
Respuesta de Dante Amor
1
H o l a:
Te anexo la macro, solamente queda un detalle, en el asunto estoy poniendo el texto:
Dirigido a: y Pago a:
Dime si es correcto o pon un ejemplo de lo que debe estar en el asunto, ya que el destinatario lo estoy tomando de la columna F.
Sub RenombrarEnviar()
'Por.Dante Amor
Columns("H").Clear
ruta = ThisWorkbook.Path & "\"
For i = 2 To Range("A" & Rows.Count).End(xlUp).Row
arch1 = Cells(i, "A")
arch2 = Cells(i, "C") & " " & Format(Cells(i, "D"), "mmmm yyyy") & ".XML"
If Dir(ruta & arch1) <> "" Then
FileCopy ruta & arch1, ruta & arch2
Set dam = CreateObject("outlook.application").createitem(0)
dam.To = Cells(i, "F")
dam.Subject = "Dirigido a : " & Cells(i, "B") & " . Pago a: " & Cells(i, "C") & Format(Cells(i, "D"), "mmmm yyyy")
dam.body = "Pago correspondiente a " & Format(Cells(i, "D"), "mmmm yyyy") & " por " & Format(Cells(i, "E"), "$#,##0.00")
dam.Attachments.Add ruta & arch2
dam.send 'El correo se envía en automático
'dam.display 'El correo se muestra
Cells(i, "H") = "Enviado"
Else
Cells(i, "H") = "no existe el archivo"
End If
Next
MsgBox "Fin"
End Sub':) ':)
