Formula if then se ejecuta 2 veces la instrucción

Tengo una macro para enviar un e-mail desde un excel cuando se cumplan una de otras opciones, pero cuando se cumple una condición en vez de enviarme 1 correo me envía 2 veces el mismo correo, ¿alguien me podría orientar?

Adjunto código usado:

If Sheets("Hoja_1").Range("I14").Value = 6 Or Sheets("Hoja_2").Range("R3").Value = 6 Then
pregunta = MsgBox("¿Está trabjando en este equipo?", vbYesNo, "Aviso")
Select Case pregunta
Case vbYes

Sheets("Hoja_1").Select
Range("A1").Select

Dim Asunto As String
Asunto = "Informe " & Sheets("Hoja_1").Range("G3")

Dim OutApp As Object
Dim OutMail As Object

Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)

On Error Resume Next
With OutMail
.To = ""
.CC = ""
.BCC = ""
.Subject = Asunto
.Body = "texto"
.Attachments.Add ActiveWorkbook.FullName
.Display

End With
On Error GoTo 0

Set OutMail = Nothing
Set OutApp = Nothing

Case vbNo
Sheets("Hoja_1").Select
Range("A1").Select
Exit Sub
End Select

Else

If Sheets("Hoja_2").Range("O3").Value >= 35 Then
pregunta = MsgBox("¿Está trabajando en este equipo?", vbYesNo, "Aviso")
Select Case pregunta
Case vbYes

...........................

Case vbNo

.............................

Exit Sub
End Select

Else

...

Respuesta
1

.

Buenas, Hose

A menos que las instrucciones de envío luego del condicional

If Sheets("Hoja_2").Range("O3").Value >= 35 then

Fueran distintas de lo que está en el primer IF, yo lo incluiría en la primera condición.

Es decir:

If Sheets("Hoja_1").Range("I14").Value = 6 Or Sheets("Hoja_2").Range("R3").Value = 6 Or Sheets("Hoja_2").Range("O3").Value >= 35 Then

...

De esa manera queda una única instancia de envío de mail.

Pruebalo y dime si te resuelve el problema.

Saludos

Fernando

.

Muchas gracias por contestarme, las instrucciones después del condicional son diferentes, lo que pasa es que le llegan 2 correos sucesivos a los destinatarios.

No veo nada del código que pueda propiciar que se envíe los 2 correos.

.

Cierto: yo tampoco lo veo.

Copié la rutina a un archivo propio y en lo que enviaste no encontré comando alguno que duplique el envío... a menos que esté en lo que no enviaste.

De todos modos, le hice algunos arreglos y propuestas que podrían serte de utilidad:

Sub iiiif()
If Sheets("Hoja_1").Range("I14").Value = 6 Or Sheets("Hoja_2").Range("R3").Value = 6 Then
    pregunta = MsgBox("¿Está trabjando en este equipo?", vbYesNo, "Aviso")
    Select Case pregunta
    Case vbYes
        Sheets("Hoja_1").Select 'elija SI o Elija NO, hace esto. Podría ir antes de Select case  
        Range("A1").Select 'elija SI o Elija NO, hace esto. Podría ir antes de Select case  
        Dim Asunto As String
        Asunto = "Informe " & Sheets("Hoja_1").Range("G3")
        Dim OutApp As Object
        Dim OutMail As Object
        Set OutApp = CreateObject("Outlook.Application")
        Set OutMail = OutApp.CreateItem(0)
        On Error Resume Next
        With OutMail
            .To = ""  'Destinatario?  
            .CC = ""
            .BCC = ""
            .Subject = Asunto
            .Body = "texto"
            .Attachments.Add ActiveWorkbook.FullName
            .Display ' este es la única salida para enviar el mail, mostrándolo primero.  
        End With
        On Error GoTo 0
        Set OutMail = Nothing
        Set OutApp = Nothing
    Case vbNo
        Sheets("Hoja_1").Select 'elija SI o Elija NO, hace esto. Podría ir antes de Select case  
        Range("A1").Select 'elija SI o Elija NO, hace esto. Podría ir antes de Select case  
        Exit Sub
    End Select
ElseIf Sheets("Hoja_2").Range("O3").Value >= 35 Then ' es un modo mas ortodoxo de hacer lo que tenías antes aqui.  
        pregunta = MsgBox("¿Está trabajando en este equipo?", vbYesNo, "Aviso")
        Select Case pregunta
        Case vbYes
            '........................... 'puede ser que aquí sea donde se producen ambos envios  
        Case vbNo
            '.............................
            Exit Sub
        End Select
End If
End Sub

Así, indentado, ayuda a ver la lógica del procedimiento.

Saludos

Fernando

.

Hola Fernando, he probado con el nuevo código y con varias modificaciones más y no hay manera, me sigue enviándome 2 correos a la vez.

La macro funciona en un excel desde un servidor remoto, no sé cómo funciona pero me parece que la macro se conecta al outlook del servidor y al outlook de mi PC y por eso envía 2 correos a la vez, el caso es que no tengo acceso al outlook remoto y supongo que habrá un momento en que se colapsará la bandeja de salida.

Es una hipótesis porque voy bastante perdido.

Todo esto lo sospecho porque en mi bandeja de salida solo hay un correo pero al destinatario le llegan 2 correos.

.

Buenos días, Hose

Es cierto, el problema parece no estar en la rutina sino en la administración del servidor de correo.

Para determinar el origen del problema, colócate como destinatario de un correo enviado de esa manera, así podrás ver el/los remintente/s de los correos que recibas.

En tal caso, la cuestión excede el ámbito de MS Excel y habrá que ver la configuración del gestor de correos.

Un abrazo

Fer

.

Me informaré por si es algo de mi correo porque solo le llegan esos correos por duplicado a mí, incluso cuando los reenvían me llegan por duplicado, a otros destinatarios le llegan bien.

Igualmente muchas gracias por contestarme.

Saludos

.

Así es, me inclino fuertemente a pensar que se trata de un conflicto en el uso del servidor remoto...

Espero que puedas resolverlo.

Un abrazo
Fer

.

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas