Señores expertos al tratar de modificar una macro no me resulta
Buenas tardes expertos, tengo el siguiente problema necesito a adecuar esta macro para que solo se active al contener 401 caracteres en una columna A de LA HOJA 1, de no tener esta candidata de caracteres debiera eliminar la hoja que esta tratando de copiar y enviar un mensaje con error en contenido, les dejo la macro.-
Sheets("hoja 1").Select
For i = 1 To Range("A" & Rows.Count).End(xlUp).Row
cad = cad + Len(Cells(i, "A"))
Next
If cad < 401 Then
'GENERA EL CORREO CON ARCHIVO ADJUNTO
Sheets("hoja 1").Copy
Application.ScreenUpdating = False
Dim dia As String
Dim tim As String
Dim nom As String
Dim ext As String
Dim Path As String
dia = Format(Date, "dd-mm-yyyy ")
tim = Format(Time(), " hh-mm-ss")
ext = ".TXT"
nom = nom + " " + dia + tim & ".TXT"
MsgBox "este es el nombre del archivo: "" " & nom
Path = "d:\" & nom
ActiveWorkbook.SaveAs Filename:=Path, FileFormat:=xlText, CreateBackup:=False
ActiveWorkbook.Close
Set OutApp = CreateObject("Outlook.Application")
OutApp.Session.Logon
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
Else
MsgBox "error en digitación ", vbCritical
Exit Sub
End If
With OutMail
.To = "xxxxx@xxxxxxx"
.CC = " "
.BCC = ""
.Subject = "xxxxxxxx" + " " + "xxxxxxxxx" + " " + "del" + " " + Str(Date)
.Body = "Buenas Tardes:" + Chr(13) + Chr(13) + "Adjunto envío a usted, solicitud para vuestra gestión" + Chr(13) + Chr(13) + "Saludos" + Chr(13) + Chr(13) + Range("d29") + Chr(13) + "Sucursal" + " " + Range("i6")
.attachments.Add "D:\" & nom
.Display
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
1 Respuesta
Estimado experto al momento de ejecutar la macro no me realiza el proceso del envío del correo aunque cumpla con la condición de if cad = 401 then inclusive la probé con una hoja de trabajo nueva.-
Experto encontré el problema, en algunas celdas de la columna a existen espacios entre las palabras, esto se podrá arreglar?
Disculpa mi torpeza pero probando bien la macro solo analiza la primera fila de la columna A en cuanto analiza la segunda fila de la columna envía el error de digitación, si solo dejo la primera fila con los 401 datos todo corre ok.-
Tienes que limpiar primero las celdas, la macro lee la primer fila y hasta la última fila con datos, incluyendo las celdas que tengan espacios.
Así que primero deberás borrar las celdas que tengan espacios
Experto todo esta limpio, dos filas de columna A con 401 caracteres y me envía el mensaje de error en digitación si solo dejo la los datos en la primera fila esta todo ok.-
Por lo poco que entiendo el For indica desde donde parte el análisis?
Sub ENVÍO()
For i = 1 To Range("A" & Rows.Count).End(xlup).Row
cad = cad + Len(Cells(i, "A"))
Next
If cad = 401 Then
Else
MsgBox "error en digitación ", vbCritical
Exit Sub
End If
End Sub
Te explico el for, este es el ciclo del for, inicia con la instrucción FOR y termina con la instrucción NEXT
For i = 1 To Range("A" & Rows.Count).End(xlup).Row
cad = cad + Len(Cells(i, "A"))
Next
Lo que hace es empezar en la fila 1 y repetir el ciclo hasta la última fila con datos que tenga la columna A.
En la variable i se va incrementando el contador, inicia en 1.
Ahora esta instrucción:
cad = cad + Len(Cells(i, "A"))
Significa que la cadena va a ser igual a la cadena mas el largo de la celda A1
Si la celda A2 tiene datos, entonces la cadena será igual al largo de A1 + el largo de A2.
Para saber cuál es la última fila con datos de la columna A, escribe esto en una nueva macro y ejecutala
Sub ultimafila()
'Por.dam
u = Range("A" & Rows.Count).End(xlUp).Row
MsgBox "la última fila es la : " & u
End Sub
Con eso ya sabes cómo trabaja el ciclo y cuál es la última fila.
En la columna B escribe esta fórmula, para saber el largo de cada celda:
=LARGO(A1)
Copia la fórmula hacia abajo para que sepas cuantos caracteres tiene cada celda, luego los sumas y tendrás el total.
Tal vez algunos caracteres o espacios hacen la diferencia.
Gracias por la explicación todo calza con lo que he investigado, pruebo lo recomendado por ti con la otra macro y el ultimo es fila 2, la fila 1 y la 2 tienen 401 caracteres cada fila, pero solo al borrar los datos de la fila 2 la macro funciona correctamente si agrego los 401 caracteres a la fila 2 me envía el error en digitación, te podre enviar el archivo para que lo revises.-
401 + 401 = 802, por eso te da error.
Para qué quieres el ciclo, ¿para qué sume caracteres? .
¿Quieres el ciclo para enviar un correo por cada fila?
No entiendo qué necesitas.
Debiera revisar columna A y si cada fila cumple con los 401 caracteres debiera enviarse el correo, si existe una fila que no cumpla esta condición debiera indicar error en digitación.-
Eso no es lo que pediste desde un principio.
La lógica de tu macro no es correcta.
Esto es lo correcto
Sub enviar()
'Mod por.DAM
Application.ScreenUpdating = False
Sheets("hoja 1").Copy
Path = "c:\" & Format(Date, "dd-mm-yyyy ") & Format(Time(), " hh-mm-ss") & ".txt"
ActiveWorkbook.SaveAs Filename:=Path, FileFormat:=xlText, CreateBackup:=False
ActiveWorkbook.Close
For i = 1 To Range("A" & Rows.Count).End(xlUp).Row
If Len(Cells(i, "A")) = 401 Then
Set dam2 = CreateObject("outlook.application").createitem(0)
dam2.To = "xxxxx@xxxxxxx"
dam2.Subject = "xxxxxxxx" + " " + "xxxxxxxxx" + " " + "del" + " " + Str(Date)
dam2.body = "Buenas Tardes:" + Chr(13) + Chr(13) + _
"Adjunto envío a usted, solicitud para vuestra gestión" + Chr(13) + Chr(13) + _
"Saludos" + Chr(13) + Chr(13) + Range("d29") + Chr(13) + "Sucursal" + _
" " + Range("i6")
dam2.Attachments.Add Path
dam2.display
End If
Next
End Sub “Para qué hacer las cosas fáciles si te las puedes complicar”
Por. DAM
