Ciclo che non funziona

Hai un problema con Excel?

Nuova discussione

Ciclo che non funziona
di Ragno (utente non iscritto) data: 19/03/2014 15:29:01
Signori questo codice non gira come dovrebbe ho provato ad impostare un ciclo con IF ma invece di mandarmi (o meglio mostrarmi in quanto .display) una mail per ogni cella dove la condizione if è esatta, mi manda le mail a tutti :(
Dove ho sbagliato?
Premetto che ho attinto da varie discussioni qui sul forum ed ho provato a mettere insieme più cose...solo che ci devono essere un po di errori qui e li, visto che ci capisco pochinio e niente...
Grazie a tutti coloro che vorranno correggere il codice.

Sub Before_Close()

    Dim OutApp As Object
    Dim OutMail As Object
    Dim EmailAddr As String
    Dim Subj As String
    Dim BodyText As String
    Dim rng As Range, data1 As Date, data2 As Date, cella
    
    Set rng = Range("d4:D1000")
    data1 = Date - 30
    data2 = Date
    For Each cella In rng
    If cella >= data1 Then
        Set OutApp = CreateObject("Outlook.Application")
        Set OutMail = OutApp.CreateItem(0)
        
      
        With OutMail
                  ' La colonna "B" contiene gli indirizzi e-mail dei vari destinatari mi dovrebbe selezionare solo quelli dal comando if, non tutti
                  .To = cella(0, -1)
                  ' La colonna "C" contiene l'indirizzo e-mail in "Copia per Conoscenza"
                  .CC = "varesi.f@xxx.it"

                  .Subject = cella(0, 2)
                  ' La colonna "E" contiene l testo della e-mail
                  
                  .Body = "THE PROCEDURE IN THE TITLE IS GOING TO EXPIRE or IS ALREADY EXPIRED"
                       
                  .Display
        End With
Set OutMail = Nothing
        Set OutApp = Nothing
        Application.SendKeys "%a"
 
End If


    
Next
End Sub

di lepat (utente non iscritto) data: 19/03/2014 16:00:43
allega un file di esempio per testare il codice
di lepat (utente non iscritto) data: 19/03/2014 16:02:15
Oppure lancia la macro con F8 e controlla le variabili dell'if

di Grograman (utente non iscritto) data: 19/03/2014 16:26:45
Variazione sul tema partendo dagli appunti, basta che rimetti la condizione dell'if e il tuo range, richiede la libreria indicata:

Sub Mail()
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''' ATTENZIONE RICHIEDE L'ATTIVAZIONE DELLA LIBRERIA MICROSOFT OUTLOOK 14.0 OBJECT LIBRARY '''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''' Per l'attivazione andare su "Strumenti", "Riferimenti", cercare e spuntare il nome '''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  Dim indirizzo As String
  Dim oOUT As Outlook.Application
  Dim oML As MailItem
  Dim messaggio As String
  Dim oggetto As String
  Dim rngC As Range, cella As Range
  
  Set rngC = Range("D1:D10")
  messaggio = "tuo messaggio"
  oggetto = "tuo oggetto"
  
  Set oOUT = CreateObject("Outlook.Application")
  For Each cella In rngC
  Set oML = oOUT.CreateItem(olMailItem)
  'If condizione then
    indirizzo = cella.Text
    With oML
      '.Attachments.Add ("C:	uo_file.pdf")
      .To = indirizzo
      .Subject = oggetto
      .Body = messaggio
      '.SentOnBehalfOfName = "ilmio@mittente.com"
      .Display
      '.Send
    End With
  'End If
  Next cella
  Set rngC = Nothing
  Set oOUT = Nothing
  Set oML = Nothing
End Sub

di Grograman (utente non iscritto) data: 19/03/2014 16:30:52
Appena utilizzato su un mio collega:

Sub Mail()
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''' ATTENZIONE RICHIEDE L'ATTIVAZIONE DELLA LIBRERIA MICROSOFT OUTLOOK 14.0 OBJECT LIBRARY '''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''' Per l'attivazione andare su "Strumenti", "Riferimenti", cercare e spuntare il nome '''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  Dim indirizzo As String
  Dim oOUT As Outlook.Application
  Dim oML As MailItem
  Dim messaggio As String
  Dim oggetto As String
  Dim rngC As Range, cella As Range
  
  Set rngC = Range("D1:D38")
  oggetto = "Spam!"
  messaggio = "Sono un Pirla!"
  
  Set oOUT = CreateObject("Outlook.Application")
  For Each cella In rngC
  Set oML = oOUT.CreateItem(olMailItem)
  'If condizione then
    indirizzo = cella.Text
    With oML
      '.Attachments.Add ("C:	uo_file.pdf")
      .To = indirizzo
      .Subject = oggetto & cella.Row
      .Body = messaggio & cella.Row
      '.SentOnBehalfOfName = "ilmio@mittente.com"
      .Display
      .Send
    End With
  'End If
  Next cella
  Set rngC = Nothing
  Set oOUT = Nothing
  Set oML = Nothing
End Sub

di Vecchio Frac data: 19/03/2014 21:13:15
Perchè .Display e .Send contemporaneamente? se visualizzo il messaggio è perchè voglio modificarlo e non inviarlo subito, e se invece lo spedisco subito non mi serve visualizzarlo.
di Grograman (utente non iscritto) data: 19/03/2014 22:48:15
Ziiii hai perfettamente ragione, mi sono semplicemente dimenticato di invertire il commento con la riga precedente :D

il "send" era inibito per ovvi motivi, ma almeno mi ricordo che fa parte dei metodi disponibili!

di Ragno (utente non iscritto) data: 20/03/2014 08:23:36
Signori ho provato ma mi fa la stessa cosa del codice che avevo postato all'inizio, ovvero mi manda le mail a tutti mentre dovrebbe mandarlo solo ad alcuni altrimenti che ci sta a fare l'IF?
Allego il file excel cosi capite meglio.
Nella colonna H rislutano 3 articoli in scadenza e quindi solo a tre persone dovrebbero essere mandate le email invece le manda a tutti.
Riallego il codice (ora so pure che si commentano) ed il file di riferimento in excel
Spero che sia stata chiara e riuscuiate ad aiutarmi

Sub Before_Close()

    Dim OutApp As Object
    Dim OutMail As Object
    Dim EmailAddr As String
    Dim Subj As String
    Dim BodyText As String
    Dim rng As Range, data1 As Date, data2 As Date, cella
    
    Set rng = Range("d4:D1000")
    data1 = Date - 30 'cioè da un mese prima di oggi mi serve perchè dovrebbe avvisare in anticipo che un ogetto è in scadenza'
   
    For Each cella In rng
    'ora mi dovrebbe mandare le email solo per gli articoli che risultano in scadenza, come nella colonna H,
    'infatti ci sono tre expired mentre il codice manda 26 mail, ovvero a tutte le linee e non solo a quelle 3
    
    If cella >= data1 Then
        Set OutApp = CreateObject("Outlook.Application")
        Set OutMail = OutApp.CreateItem(0)
        
      
        With OutMail
                  ' La colonna "B" contiene gli indirizzi e-mail dei vari destinatari
                  .To = cella(0, -1)
                  ' La colonna "C" contiene l'indirizzo e-mail in "Copia per Conoscenza"
                  .CC = "varesi.f@fater.it"

                  .Subject = cella(0, 2)
                  ' La colonna "E" contiene l testo della e-mail
                  
                  .Body = "THE PROCEDURE IN THE TITLE IS GOING TO EXPIRE or IS ALREADY EXPIRED"
                       
                  .Display
        End With
Set OutMail = Nothing
        Set OutApp = Nothing
        Application.SendKeys "%a"
 
End If


    
Next
End Sub

di lepat (utente non iscritto) data: 20/03/2014 09:13:36
in colonna D ha messo tutte date col 2015, quindi soddisfano tutte la condizione
If cella >= data1 Then

di Ragno (utente non iscritto) data: 20/03/2014 09:43:39
mi sono accorto di un paio di errori (in primis avevo impostato maggiore invece di minore...che pirla....) ed ho riscritto il codice che allego qui, però ora ho scoperto un altro problema...
Nella definizione del range per le date devo impostare da d4:a ultima cella per evitare che mi spedisca 1000 emails vuote.....
Ho provato con If cella <= data1 And cella <> "" Then secondo voi è consono o porta problemi che magari non ho considerato?
Così sembra funzioni, allego il codice magari può servire come sounto a qualcuno :)
Grazie a tutti, sono contento qualcosina l'ho capita

Sub Before_Close()

    Dim OutApp As Object
    Dim OutMail As Object
    Dim EmailAddr As String
    Dim Subj As String
    Dim BodyText As String
    Dim rng As Range, data1 As Date, data2 As Date, cella
    
    Set rng = Range("d4:D100")
    data1 = Date + 30 'cioè da un mese prima di oggi mi serve perchè dovrebbe avvisare in anticipo che un ogetto è in scadenza'
   
    For Each cella In rng
    'ora mi dovrebbe mandare le email solo per gli articoli che risultano in scadenza, come nella colonna H,
    'infatti ci sono tre expired mentre il codice manda 26 mail, ovvero a tutte le linee e non solo a quelle 3
    
    If cella <= data1 And cella <> "" Then
        Set OutApp = CreateObject("Outlook.Application")
        Set OutMail = OutApp.CreateItem(0)
     
     
      
        With OutMail
                  ' La colonna "B" contiene gli indirizzi e-mail dei vari destinatari
                  .To = cella(1, -1)
                  ' La colonna "C" contiene l'indirizzo e-mail in "Copia per Conoscenza"
                  .CC = "varesi.f@fater.it"

                  .Subject = cella(1, 2)
                  ' La colonna "E" contiene l testo della e-mail
                  
                  .Body = "THE PROCEDURE IN THE TITLE IS GOING TO EXPIRE or IS ALREADY EXPIRED"
                       
                  .Display
        End With
Set OutMail = Nothing
        Set OutApp = Nothing
        Application.SendKeys "%a"
 
End If


    
Next
End Sub

Vuoi Approfondire?