Enviar un archivo txt de nombre variable (Galicia*.txt) por yahoo mail con VBA

Muy interesante el foro, eh resuelto dudas solo con lo ya posteado, pero ahora acudo a ustedes para resolver como enviar un adjunto con Gmai usando una macro en excel. Actualmente mando solo una hoja, pero necesito agragarle al mismo envío un archivo txr cuya ubicacion es D:\Users\User\Documents\Galicia_CCI_22135_09072018.txt, pero este cambia el final de su  nombre cada vez que se genera (Galicia_CCI_*.txt)

Mi código actual es:

Sub Eviar_Detalle_p_pagar_x_mail()

Sheets("Planilla de pagos").Select
    ActiveSheet.Unprotect
    ActiveSheet.Range("$N$5:$N$100").AutoFilter Field:=1, Criteria1:="="
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Sheets("Planilla de pagos").Select
hoja = "Planilla de pagos"
correo = "[email protected]"
passwd = "ddddxxxxx"
destino = "[email protected]"
cuerpo = "Planilla de pagos"
'Application.DisplayAlerts = False
Application.ScreenUpdating = False
ruta = ThisWorkbook.Path & "\"
nombre = Sheets(hoja).Name
Sheets(hoja).Copy
ActiveWorkbook.SaveAs Filename:=ruta & nombre & ".xlsx"
ActiveWorkbook.Close False
Dim Email As CDO.Message
Set Email = New CDO.Message
Email.Configuration.Fields(cdoSMTPServer) = "smtp.mail.yahoo.com"
Email.Configuration.Fields(cdoSendUsingMethod) = 2
With Email.Configuration.Fields
   .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = CLng(465)
   .Item("http://schemas.microsoft.com/cdo/" & "configuration/smtpauthenticate") = Abs(1)
   .Item("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 30
   .Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = correo
   .Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = passwd
   .Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
End With
With Email
    .To = destino
    .From = correo
    .Subject = "Planilla de pagos"
    .TextBody = cuerpo
    .AddAttachment ruta & nombre & ".xlsx"
    .Configuration.Fields.Update
    On Error Resume Next
    .Send
End With
Kill ThisWorkbook.Path & "\Planilla de pagos.xlsx"
If Err.Number = 0 Then
    MsgBox "El correo se envio con éxito", vbInformation, "Informe"
Else
    MsgBox "Se produjo el siguiente error: " & Err.Description, vbCritical, "Error nro " & Err.Number
End If
End Sub

Añade tu respuesta

Haz clic para o