Macro urgente

Hola:
Mi pregunta es la siguiente, espero me puedan ayudar.
En la siguiente mensaje:
Correo:
Sr (NOMBRE):
Le informo a usted que el día (DÍAS), el N° (NUMERO), y el (NUM2)
Lo que necesito es que donde sale el mensaje del correo (predeterminado), poder copiar los datos que salen en el siguiente orden:
A=DIAS; B=NUMERO; C=NOMBRE y D=NUM2, estos datos estan en una hoja, que tiene nombre Info, dentro del mismo excel, donde esta ubicado la macro.
Ese mensaje tiene que ir enviadopor correo (OUTLOOK), a muchas personas, eso quiere decir que en la columna A, hay una lista de días, al igual que en las otras.
edesde ya agradezco su ayuda.

3 respuestas

Respuesta
1
Que onda amigo:
A ver, vamos por partes porque no te entendí completamente.
Tienes un archivo de excel con una macro, ¿cierto?
Dentro del archivo de excel, por poner un ejemplo, en la celda A1 tienes un numero que corresponde a DÍAS, en la celda B1 tienes un numero que corresponde a NUMERO, en la celda C1 tienes un texto que corresponde a un nombre, y en la celda D1 tienes un numero correspondiente a NUM2. ¿Es correcto como lo entendí?
Y ya tienes la macro para obtener estos valores, ¿correcto?
Lo que quieres es que con los datos obtenidos de la hoja de excel mediante tu macro, se agregue código para que se puedan enviar correos a las personas de acuerdo al dato obtenido NOMBRE. ¿Estoy bien?
Ahora, en el correo, en la sección To: (es decir, el emisor), ¿debe corresponder también a NOMBRE?
Es otra de las cosas que no entendí bien... A que te refieres con que debe ser enviado a muchas personas: ¿Un correo por persona o un mismo correo a muchas personas?
Bueno, mientras espero tu respuesta, comienzo a checar como sería el código...
Seguimos aquí...
Si, es así como tu dices, yo tengo una macro creado, pero necesito editar el mensaje.
Sub correo()
   Dim objOutlook As Object
   Dim objMail As Object
   Dim objOutlookAttach As Object
    Set objMail2 = objOutlook2.CreateItem(olMailItem)
    Set objOutlookAttach2 = objOutlook2.CreateItem(olAttachMents)
    With objMail2
         .To = ((xxxxxx))
         .Subject = "prueba"
         .Body = mail()
         .Send
    End With
            Set objMail = Nothing
            Set objOutlook = Nothing
End Sub
Function mail()
mail = _
Sr (NOMBRE):
Le informo a usted que el día (DÍAS), el N° (NUMERO), y el (NUM2)
 End Function
Es igual a lo que tu dices, lo que tiene que haces, es enviar un correo, al mail predeterminado, con los datos datos en la hoja2.
EJ:
Días numero nombre num2
4 2 gato 3
5 6 perro 4
Y debería enviarse correos con la siguiente información:
Correo1
Sr gato:
Le informo a usted que el día 4, el N° 2, y el 3
Correo2
Sr perro:
Le informo a usted que el día 5, el N° 6, y el 4
La lista de la información no siempre es de 2, pueden ser más de 10.000
Te expongo unas ideas a ver si es lo que estas buscando, pues si ya tienes el código, todavía no entiendo cual es la pregunta esencial.
Suponiendo que tengas en la columna E, los correos correspondientes a los nombres... (no se de donde obtienes los correos)... podrías generar un for que vaya mandando los correos, al recorrer fila por fila, hasta que en la columna CORREOS, ya no encuentre texto, es decir, que la celda esté vacía.
Me explico... Suponiendo que tienes una hoja de excel así:
A B C D E
1 Días numero nombre num2 correo
2 4 2 gato 3 [email protected]
3 5 6 perro 4 [email protected]
Y en tu código tienes esto:
With objMail2
         .To = ([email protected])
         .Subject = "prueba"
         .Body = mail()
         .Send
End With
Podrias agregar lo siguiente:
Dim Fin As Long
Dim Ciclo As Long
Dim Correo As String
Fin = 65536    ' Cantidad de filas en hoja de excel (Office 2007)
For Ciclo = 2 To Fin
Correo = Sheets("Sheet1").Cells(Ciclo, 5).FormulaR1C1
    If Correo = "" Then
        Exit For
    Else
        With objMail2
             .To = Correo   ' Variable que guarda el correo
                                    ' y que ira cambiando conforme
                                    ' se vayan leyendo las filas de la
                                    ' columna CORREO
             .Subject = "prueba"
             .Body = mail()
             .Send
        End With
    End If
Next
No lo he probado. Seria cosa de que hicieras las pruebas necesarias, pues como no se si es lo que buscas, que tal que me pongo a hacer pruebas y resulta que no es lo que quieres.
Si no, te pido que intentes explicar un poco más a detalle (y no me refiero al código), tu idea.
Disculpa, aunque me has dado bastantes datos, no he terminado de entenderte :-P
Mira, copie el siguiente código en la macro.
Sub Macro1()
'
Dim Fin As Long
Dim Ciclo As Long
Dim Correo As String
Fin = 65536    ' Cantidad de filas en hoja de excel (Office 2007)
For Ciclo = 2 To Fin
Correo = Sheets("Sheet1").Cells(Ciclo, 5).FormulaR1C1
    If Correo = "" Then
        Exit For
    Else
        With objMail2
             .To = Correo   ' Variable que guarda el correo
                                    ' y que ira cambiando conforme
                                    ' se vayan leyendo las filas de la
                                    ' columna CORREO
             .Subject = "prueba"
             .Body = mail()
             .Send
        End With
    End If
Next
End Sub
Function mail()
mail = _
"Sr(a) (NOMBRE) " & Chr(10) & Chr(10) & _
"le informo a usted que el dia (DIAS), el N° (NUMERO), y el (NUM2)." & Chr(10) & Chr(10) & _
"gracias."
End Function
Me sale depurar, y marca todo lo que esta en negro.
Agradeciendo de antemano tu ayuda.
Estaba pensando en hacer una función que recorriera cada uno de los datos:
Function DIAS()
    Cells(2, 1).Select
    Do While Not IsEmpty(ActiveCell)
        Dim x As String
        x = ActiveCell.Value
        Cel = ActiveCell.Address
        Range(Cel).Select
        ActiveCell.Offset(1#).Select
    Loop
Pero como lo voy a agregar en el mensaje? el mensaje tambien es una funcion.
Function mail()
mail = _
"Sr(a) (NOMBRE) " & Chr(10) & Chr(10) & _
"le informo a usted que el dia (DIAS), el N° (NUMERO), y el (NUM2)." & Chr(10) & Chr(10) & _
"gracias."
End Function
sirve?
Probé tu código y esta muy bien.
Dejame comentarte un detalle:
- No es necesario que indiques el Dim x As String dentro del Do. Bien puede quedar fuera.
Ahora, el código que escribiste, más el código para llamar a tu función Mail, te puede quedar un código algo largo, y quizá no sea necesario que quede tan largo.
Dejame detallar un poco lo que te había escrito:
' La variable Fin es Long, pues puede llegar a contener las 65536 filas que tiene excel (office 2007)
Dim Fin As Long 
' La variable Ciclo, que pertenece al for, tambien es Long, pues va a ir leyendo cada fila, pudiendo llegar a las mismas 65536
Dim Ciclo As Long 
' Correo pues es String, pues va a contener el texto (correo) de la celda en la que se encuentre, dentro del for
Dim Correo As String 
' Asigno el valor correspondiente al total de filas de excel (Office 2007)
' Para hacer tus pruebas, cambia 65536, por un numero corto, ej 5, y veas si salen los 5 correos, en lugar de checar si salen los 65536 correos, suponiendo que tu lista fuera de 65536.
Fin = 65536    ' Cantidad de filas en hoja de excel (Office 2007) 
' Suponiendo que en la fila 1, tengas tus encabezados, como son Dias, Nombre, Numero, etc, es por lo que indico que el for comience en la fila 2.
' Ciclo va a ir aumentando (como es obvio), a 2, 3, 4, etc, que corresponderia a la fila 2, 3, 4, etc.
For Ciclo = 2 To Fin 
' Al usar Sheets("nombredelahoja"), indicas en que hoja se va a aplicar la macro. En cells (que es donde debe estar el error), estoy indicando que recorra, de la columna 5, es decir, la columna E, la fila Ciclo, es decir, de acuerdo al for, fila 2, fila 3, fila 4, etc.
' Tendrias que cambiar el numero 5, correspondiente a la columna E, el valor, correspondiente a la columna donde se encuentre la lista de correos, por lo que si la lista esta en la columna A, el 5 lo debes cambiar por 1. Si la lista esta en B, el 5 por el 2.
Correo = Sheets("Sheet1").Cells(Ciclo, 5).FormulaR1C1 
' Ok, ahora. Correo va a guardar el texto (correo) conforme vaya avanzando el for.
' Cuando la celda activa, en la que se encuentre el for, este vacia...
    If Correo = "" Then 
' Va a salir del For, y continuara con el codigo posterior al For
        Exit For 
' Mientras la celda activa, tenga texto, la variable correo, va a ser diferente a "", por lo que...
    Else 
' Se ejecutaria el codigo que tu ya tenias hecho, y si te das cuenta, ya incluye en tu seccion .Body, la llamada a tu funcion mail
        With objMail2 
' .To = Correo. Como puedes imaginar, en cada for, "correo" ira obtenidneo cada texto (correo), dentro de tu lista, asi que asignará a To, el texto que contenga la variable Correo.
             .To = Correo   ' Variable que guarda el correo 
                                    ' y que ira cambiando conforme 
                                    ' se vayan leyendo las filas de la 
                                    ' columna CORREO 
             .Subject = "prueba" 
             .Body = mail() 
             .Send 
        End With 
    End If 
Next
¿Si me explique?
Ahora, para el contenido del mensaje, deja pruebo y ya te comento lo que se me ocurre, ¿te parece?
Muchas gracias por tu ayuda, espero tu respuesta.
Mira, este código hace que me agregue los datos:
Public Nombre, Dia, Numero, Num2
Sub Dias()
    Cells(2, 8).Select
    Do While Not IsEmpty(ActiveCell)
        Nombre = ActiveCell.Value
        Dia = Cells(ActiveCell.Row, 11)
        Numero = Cells(ActiveCell.Row, 1)
        Num2 = Cells(ActiveCell.Row, 2)
        ActiveCell.Offset(1#).Select
        mail
    Loop
End Sub
Sub mail()
Dim Correo As Object
Dim Mensaje As Object
Set Correo = CreateObject("Outlook.Application")
Set Mensaje = Correo.CreateItem(0)
With Mensaje
.Subject = "Asunto animales" & Nombre
.Body = "Sr(a) " & Nombre & Chr(10) & Chr(10) & _
"le informo a usted que el dia " & Dia & ", el N°" & Numero & ", y el " & _
Num2 & "." & Chr(10) & Chr(10) & "gracias."
Mensaje.To = "(xxxxxx)"
Mensaje.Send
End With
End Sub
Pero no se como agregarlo a mi macro original, me puedes ayudar?
Sub SendMail()
   Dim objOutlook As Object
   Dim objMail As Object
   Dim objOutlookAttach As Object
   Cells(2, 2).Select
   Do While Not IsEmpty(ActiveCell)
        Dim x As String
        x = ActiveCell.Value
        cel = ActiveCell.Address
        Call lateral(x)
        Range(cel).Select
        ActiveCell.Offset(1, 0).Select
     Loop
   Set objMail = Nothing
   Set objOutlook = Nothing
End Sub
Sub lateral(x)
    Dim objOutlook2 As Object
    Dim objMail2 As Object
    Dim objOutlookAttach2 As Object
    Dim cont As Integer
    Dim cadena As String
    cadena = ";"
    cont = 0
    For i = 0 To 10000
        ActiveCell.Offset(0, 1).Select
        If (ActiveCell.Value = "") Then
            cont = cont + 1
            If (cont > 5) Then
                i = 10000
            End If
        Else
            Dim p As String
            p = ActiveCell.Value
            If (ActiveCell.Value <> "") Then
                cadena = p & ";" & cadena
            End If
        End If
    Next
    cadena = cadena & x
    Set objOutlook2 = CreateObject("Outlook.Application")
    Set objMail2 = objOutlook2.CreateItem(olMailItem)
    Set objOutlookAttach2 = objOutlook2.CreateItem(olAttachMents)
      With objMail2
         .To = cadena
         .Subject = "prueba"
         .Body = ""Sr(a) " & Nombre & Chr(10) & Chr(10) & _
"le informo a usted que el dia " & Dia & ", el N°" & Numero & ", y el " & _
Num2 & "." & Chr(10) & Chr(10) & "gracias."
         .Send
    End With
            Set objMail = Nothing
            Set objOutlook = Nothing
End Sub
Por favor me puedes ayudar a unir los 2 códigos.
Ok, deja lo checo y vemos como lo unimos...
Gracias.
Espero tu aclaración
Aquí ando amigo, checando tu código
Mira, te voy a escribir en varios mensajes, para que no se junte todo el código, y me explique bien...
Para empezar...
¿Este es el código que quieres agregar a tu código cierto?
Public Nombre, Dia, Numero, Num2 
Sub Dias() 
    Cells(2, 8).Select 
    Do While Not IsEmpty(ActiveCell) 
        Nombre = ActiveCell.Value 
        Dia = Cells(ActiveCell.Row, 11) 
        Numero = Cells(ActiveCell.Row, 1) 
        Num2 = Cells(ActiveCell.Row, 2) 
        ActiveCell.Offset(1#).Select 
        mail 
    Loop 
End Sub 
Sub mail() 
Dim Correo As Object 
Dim Mensaje As Object 
Set Correo = CreateObject("Outlook.Application") 
Set Mensaje = Correo.CreateItem(0) 
With Mensaje 
.Subject = "Asunto animales" & Nombre 
.Body = "Sr(a) " & Nombre & Chr(10) & Chr(10) & _ 
"le informo a usted que el dia " & Dia & ", el N°" & Numero & ", y el " & _ 
Num2 & "." & Chr(10) & Chr(10) & "gracias." 
Mensaje.To = "[email protected]
Mensaje.Send 
End With 
End Sub
Si
Por otro lado, no consigo entender por completo que hace tu código, con respecto a lo siguiente:
En Sub SendMail()  
Dim objOutlook As Object 
   Dim objMail As Object 
   Dim objOutlookAttach As Object
   Set objMail = Nothing
   Set objOutlook = Nothing
   Set objMail = Nothing   Set objOutlook = Nothing
Si nos lo ocupas, no es necesario indicarlos...
----------
cel = ActiveCell.Address
el resultado de esto es por ejemplo B$2$, B$3$, correspondiente a la celda B2, B3, pero no haces nada con esa variable... Me queda la duda: para que requieres esa variable? la ocupas en codigo adicional que tienes?
-------------
Te sigo escribiendo... no me contestes todavía...
Perdón, no vi que SI usabas la variable cel...
-----
El codigo como quedaria segun yo, sería:
(Primera seccion)
Sub SendMail()
Dim x As String
Dim cel As String
   Cells(2, 2).Select
   Do While Not IsEmpty(ActiveCell)
        x = ActiveCell.Value
        cel = ActiveCell.Address
        Call lateral(x)
        Range(cel).Select
        ActiveCell.Offset(1, 0).Select
     Loop
End Sub
Ahora te escribo la 2da parte...
(2da parte)
Sub lateral(x) 
No es necesario crear objOutlook1, objOutlook2, etc.
Si tienes Sub uno, Sub dos, en cada uno puedes tener objOutlook, pues el objeto esta dentro de un sub diferente. Incluso, si usaras el objeto para varias cosas, no es necesario crear muchos objOutlook si hacen referencia al mismo objeto
    Dim objOutlook As Object 
    Dim objMail As Object 
' si la linea siguiente no la usas, no tiene caso escribirla
'    Dim objOutlookAttach2 As Object 
    Dim cont As Integer 
    Dim cadena As String 
Dim p As String
    cadena = ";" 
    cont = 0
For i = 0 To 10000 
        ActiveCell.Offset(0, 1).Select 
        If (ActiveCell.Value = "") Then 
            cont = cont + 1 
            If (cont > 5) Then 
                i = 10000 
            End If 
        Else 
            p = ActiveCell.Value 
            If (ActiveCell.Value <> "") Then 
                cadena = p & ";" & cadena 
            End If 
        End If 
    Next
cadena = cadena & x
 Set objOutlook = CreateObject("Outlook.Application")
    Set objMail = objOutlook.CreateItem(olMailItem)
      With objMail
         .To = cadena
         .Subject = "prueba"
         .Body = "Sr(a) " & Nombre & Chr(10) & Chr(10) & _
"le informo a usted que el dia " & Dia & ", el N°" & Numero & ", y el " & _
Num2 & "." & Chr(10) & Chr(10) & "gracias."
         .Send
    End With
            Set objOutlook = Nothing
            Set objMail = Nothing
End Sub
Se me paso... Debes quitarle lo que esta en negritas
Dim cadena As String  
Dim p As String 
    cadena = ";"
Así, ya es funcional, por lo menos en las pruebas que hice...
Ahora, como no se en que celdas esta Nombre, Num2, y así en tu hoja de excel, no se como adaptarlo al código.
Por lo tanto, necesito que me dibujes como esta tu hoja de excel.
Me tardo más, adivinando como esta tu hoja, y adaptar el código, que en el código mismo.
Así que si quieres que te termine de ayudarte, dibujame como esta tu hoja de excel
Hoja 1
persona             correo                   copia
x            (xxxxxx)      (xxxxxx)
hoja 2
numero   nombre dias num2 
1 gato 4 2
2 perro 5 3
Son solo 2 hojas, y esa es la información que tiene.
Pero, ¿persona esta en la celda A1, A2, B2?
Numero esta en la celda A1, ¿etc?
Hoja 1
    A B C
1  persona             correo                   copia
2 x (xxxxxx)  (xxxxxx)
hoja 2
   A B C D
1 numero nombre días num2
         1 gato 4 2
2 2 perro 5 3
En A1 esta el campo persona
Como ves lo siguiente:
(Primera parte)
Private Sub SendMail()
        Sheets(1).Select
        Cells(2, 2).Select
   Do While Not IsEmpty(ActiveCell)
        Dim x As String
        x = ActiveCell.Value
        cel = ActiveCell.Address
        Call lateral(x)
        Range(cel).Select
        ActiveCell.Offset(1, 0).Select
   Loop
End Sub
Le agregue Sheets(1). Select para que comience con los datos de la hoja 1
(2da parte)
Private Sub lateral(x)
    Dim objOutlook As Object
    Dim objMail As Object
    Dim cont As Integer
    Dim cadena As String
    Dim p As String
    Dim Fila As Long
    cont = 0
Fila = ActiveCell.Row
For i = 0 To 10000
        ActiveCell.Offset(0, 1).Select
        If (ActiveCell.Value = "") Then
            cont = cont + 1
            If (cont > 5) Then
                i = 10000
            End If
        Else
            p = ActiveCell.Value
            If (ActiveCell.Value <> "") Then
                cadena = p & ";" & cadena
            End If
        End If
Next
    cadena = cadena & x
 Set objOutlook = CreateObject("Outlook.Application")
    Set objMail = objOutlook.CreateItem(0)
      With objMail
        .To = cadena
        .Subject = "prueba"
        .Body = Mensaje(Fila)
        .Send
    End With
            Set objOutlook = Nothing
            Set objMail = Nothing
End Sub
Le agregue Fila = ActiveCell.Row para que guarde la fila en la que va en la hoja 1, y al leer los datos de la hoja 2, la fila sea la correspondiente a la hoja 1.
Igualmente en .Body = Mensaje(Fila) estoy llamando a la función Mensaje, y le paso de parámetro el numero correspondiente a la fila.
(3ra parte)
Esta es la función Mensaje que recibe el parámetro correspondiente a la fila.
Private Function Mensaje(NumFila)
Dim NUMERO As Integer
Dim NOMBRE As String
Dim DIA As Integer
Dim NUM2 As Integer
NUMERO = Sheets(2).Cells(NumFila, 1).Value
NOMBRE = Sheets(2).Cells(NumFila, 2).Value
DIA = Sheets(2).Cells(NumFila, 3).Value
NUM2 = Sheets(2).Cells(NumFila, 4).Value
Mensaje = "Sr(a) " & NOMBRE & Chr(10) & Chr(10) & _
"le informo a usted que el dia " & DIA & ", el N°" & NUMERO & ", y el " & _
NUM2 & "." & Chr(10) & Chr(10) & "
Espero te sirva...
Cualquier cosa, me dices...
Dejame comentarte algo:
Si escribes Sub Algo(), es como si escribierasa Public Sub Algo(), haciendo de tu sub, publica.
Mientras todas las sub estén en el mismo modulo, como en este caso, las puedes ir llamando (Call) desde cualquier sub, aun cuando sean Private.
Ya si tuvieras 2 diferentes modulos y quisieras llamar a un Sub de un modulo, desde otro modulo, entonces si seria necesario definirlas como Public Sub...
No me funcionaron los códigos, pero ya termine esa parte de la macro.
Gracias.
Ok, pues tu me dices en que te ayudo, pero necesito la info completa desde el inicio...
Finaliza tu pregunta, si consideras que ya no requeires de ayuda por mi parte, con respecto a este tema...
Respuesta
-1
Hay que poner para grabar la macro con las acciones. Se pone "rec" y se pone buscar la palabra "DIAS" y stop
Después se pone copiar en la selección la celda de la columna "A", y así con el resto
En principio
Respuesta
-1
En realidad el pedir una macro así con llevaría a prácticamente hacerte todo el trabajo, por lo que yo te recomiendo darle una leidita a esta web:
http://www.rondebruin.nl/sendmail.htm
Y posterior a eso intentarlo tu mismo, y ya sobre tu avance y preguntas más puntuales te aseguro que sera más fácil ayudarte.
Abraham

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas