Macro para evitar repetir 700 veces las mismas intruscciones

On 22 mayo, 20:54, kino2 wrote:

Buenas dias
 Trato de montar un bucle o algo parecido, porque tener que repetir casi 700
 veces un grupo de instrucciones (con ligeras variables) me parece de
 ignorantes...

 En una macro de excell tengo un código que lo que hace es enviar por mail
 (a través de lotus) un fichero determinado (alojado en una
 ubicación concreta)  a una dirección determinada (registrada en
 una celda concreta de una hoja excell concreta) : se trata de enviar 700
 ficheros distintos (nombrados de forma distinta) a 700 direcciones de mail
 diferentes.

 Tal y como lo tengo ahora mismo desarrollado, "cojo" un determinado
 fichero excell y le mando a una determinada dirección (dicha
 dirección la tengo registrada en una determinada celda de una hoja
 excell)
 El numero de envíos ha pasado de 24 a casi 700 de ahí mi problema

 Ejemplo: En el código que trascribo a continuación envió a
 la dirección que figura en la celda A1 un mail donde adjunto el fichero
 llamado "4019" que esta alojado en "C"

 Set MailDoc = Maildb.CREATEDOCUMENT
 MailDoc.Form = "Memo"
 Recipient = Sheets("hoja_excell_de_mails").Range("A1").Value
 MailDoc.SendTo = Recip

 MailDoc.Subject = "Envio de su fichero excell"
 MailDoc.Body =  "Buenos dias les adjuntamos su fichero excell del presente
 mes."
 MailDoc.SaveMessageOnSend = True

 Attachment1 = "C:4019.xls"

 If Attachment1 <> "" Then
 On Error Resume Next
 Set AttachME = MailDoc.CREATERICHTEXTITEM("attachment1")
 Set EmbedObj1 = AttachME.embedobject(1454, "attachment1",
 "C:4019.xls", "")
 On Error Resume Next
 End If

 MailDoc.PostedDate = Now()
 On Error GoTo errorhandler1
 MailDoc.SEND 0, Recipient

 Con la nueva ampliación, este grupo de instrucciones que hasta ahora lo
 "repetía" (con las modificaciones lógicas de la
 definición de la celda y el nombre del fichero) 24 veces ahora tengo que
 repetirlos casi 700.

 Las "variables" serian:
 Para las direcciones: A1, A2, A3...(en la celda A1 tengo metida una
 dirección de mail, en la celda A2 tengo metida otra dirección de
 mail...)
 Para los ficheros adjuntos: no serian consecutivos...4019, 4022, 4023, 4024

 Rogaría cualquier ayuda o sugerencia que me pudieran prestar.

 Un saludo y muchas gracias

Hola!

Tienes que meter el código que funciona en un bucle for y que lo
repita 700 veces o ponerle una bandera a la celda 701 y que sea esta
la que acabe con el bucle.

Si necesitas alguna información más no dudes en preguntar.

Saludos

smartito escribió el 27/05/2011 11:14 :

On 22 mayo, 20:54, kino2 wrote:

Buenas dias
 Trato de montar un bucle o algo parecido, porque tener que repetir casi
700
 veces un grupo de instrucciones (con ligeras variables) me parece de
 ignorantes...

 En una macro de excell tengo un código que lo que hace es enviar
por mail
 (a través de lotus) un fichero determinado (alojado en una
 ubicación concreta)  a una dirección determinada
(registrada en
 una celda concreta de una hoja excell concreta) : se trata de enviar 700
 ficheros distintos (nombrados de forma distinta) a 700 direcciones de
mail
 diferentes.

 Tal y como lo tengo ahora mismo desarrollado, "cojo" un
determinado
 fichero excell y le mando a una determinada dirección (dicha
 dirección la tengo registrada en una determinada celda de una
hoja
 excell)
 El numero de envíos ha pasado de 24 a casi 700 de ahí mi
problema

 Ejemplo: En el código que trascribo a continuación
envió a
 la dirección que figura en la celda A1 un mail donde adjunto el
fichero
 llamado "4019" que esta alojado en "C"

 Set MailDoc = Maildb.CREATEDOCUMENT
 MailDoc.Form = "Memo"
 Recipient =
Sheets("hoja_excell_de_mails").Range("A1").Value
 MailDoc.SendTo = Recip

 MailDoc.Subject = "Envio de su fichero excell"
 MailDoc.Body =  "Buenos dias les adjuntamos su fichero excell
del presente
 mes."
 MailDoc.SaveMessageOnSend = True

 Attachment1 = "C:4019.xls"

 If Attachment1 <> "" Then
 On Error Resume Next
 Set AttachME = MailDoc.CREATERICHTEXTITEM("attachment1")
 Set EmbedObj1 = AttachME.embedobject(1454, "attachment1",
 "C:4019.xls", "")
 On Error Resume Next
 End If

 MailDoc.PostedDate = Now()
 On Error GoTo errorhandler1
 MailDoc.SEND 0, Recipient

 Con la nueva ampliación, este grupo de instrucciones que hasta
ahora lo
 "repetía" (con las modificaciones lógicas de la
 definición de la celda y el nombre del fichero) 24 veces ahora
tengo que
 repetirlos casi 700.

 Las "variables" serian:
 Para las direcciones: A1, A2, A3...(en la celda A1 tengo metida una
 dirección de mail, en la celda A2 tengo metida otra
dirección de
 mail...)
 Para los ficheros adjuntos: no serian consecutivos...4019, 4022, 4023,
4024

 Rogaría cualquier ayuda o sugerencia que me pudieran prestar.

 Un saludo y muchas gracias

Hola!

Tienes que meter el código que funciona en un bucle for y que lo
repita 700 veces o ponerle una bandera a la celda 701 y que sea esta
la que acabe con el bucle.

Si necesitas alguna información más no dudes en preguntar.

Saludos

Hola buenas...uff la que he montado hoy en el trabajo!! (hasta he tenido que hablar con la central para avisar de porqué salian tropezientos de correos a una misma dirección ..pero bueno creo que ahi ha quedado la cosa)
En la hoja excell en la celda A1 tengo una cuenta de correo: llamemosla cuenta1
en la celda A2 tengo otra cuenta de correo: llamemosla cuenta2
En la hoja excell en la celda B1 hay un fichero llamado 4021
en la celda B2 hay otro fichero llamdo 4022
Con el codigo que a continuacion trascribo hoy me ha pasado lo siguiente:
1. Me ha lanzado tropezientos correos a la cuenta1 (no he detectado ninguno a la cuenta2, tambien es cierto que he paralizado la replicacion del lotus notes..)
2. No me ha adjuntado ningun archivo (tenia que haber adjuntado el archivo llamado "4021"
(sabeis si existe algún lotus virtual con el que pueda realizar pruebas...??
Te trascribo el codigo que tengo implantado, cualquier ayuda para mi realmente es muy agradecida.
Sub LotusNotsCoreCode()

Dim UserName As String
Dim MailDbName As String
Dim Recipient As String
Dim ccRecipient As String
Dim mens As String

Dim Attachment1 As String
Dim Maildb As Object
Dim MailDoc As Object
Dim AttachME As Object
Dim Session As Object


Const path As String = "C:\"
Const ext As String = ".xls"
With Application
.ScreenUpdating = False
.DisplayAlerts = False
End With
' Abro la sesion del usuario del lotus

Set Session = CreateObject("Notes.NotesSession")
UserName = Session.UserName
MailDbName = Left$(UserName, 1) & Right$(UserName, (Len(UserName) - InStr(1, UserName, " "))) & ".nsf"
Set Maildb = Session.GetDatabase("", MailDbName)


If Maildb.IsOpen = True Then
Else
Maildb.OPENMAIL
End If


Range("A1").Select
While ActiveCell.Value <> ""
Set MailDoc = Maildb.CREATEDOCUMENT
MailDoc.Form = "Memo"
Recipient = ActiveCell.Value
MailDoc.SendTo = Recipient
MailDoc.Subject = "Envio de su fichero excell"
MailDoc.Body = "Buenos dias les adjuntamos su fichero excell del presente mes."
MailDoc.SaveMessageOnSend = True

Attachment1 = path & ActiveCell.Offset(0, 1).Value & ext

If Attachment1 <> "" Then
On Error Resume Next
Set AttachME = MailDoc.CREATERICHTEXTITEM("attachment1")

On Error Resume Next
End If

MailDoc.PostedDate = Now()
On Error GoTo errorhandler1
MailDoc.SEND 0, Recipient
Wend
Set Maildb = Nothing
Set MailDoc = Nothing
Set AttachME = Nothing
Set Session = Nothing


With Application
.ScreenUpdating = True
.DisplayAlerts = True
End With

errorhandler1:

Set Maildb = Nothing
Set MailDoc = Nothing
Set AttachME = Nothing
Set Session = Nothing


mens = MsgBox("Envio realizado por favor salga de la aplicación")

End Sub

un saludo