Macro invio mail con allegato

Hai un problema con Excel?

Nuova discussione

Macro invio mail con allegato
di Alex (utente non iscritto) data: 06/11/2014 09:57:12
Buongiorno ragazzi,

help me please!!:)

Utilizzando un file excel, avrei bisogno di una macro che mi permetta di inviare automaticamente, a diversi destinatari, una mail con Outlook2010.
Questa mail, avrà ovviamente nel campo "TO:" il destinatario di riferimento, mentre in "CC:", "OGGETTO" e nel corpo della mail non ci sarà bisogno di fare differenze, perchè il contenuto sarà uguale per tutte le mail.
Inoltre, avrei bisogno che, per ogni mail, venisse allegato un file in word, che sarà differente per ogni destinatario.

Per essere più chiaro, ho allegato anche il file excel, che ho così organizzato:
- Colonna A (TO:)= elenco dei destinatari
- Colonna B (CC:)= elenco dei destinatari da mettere in copia, che sarà uno uguale per tutti
- Colonna C (OGGETTO)= oggetto della mail, che sarà composto dalla stringa uguale per tutte le mail "autorizzazione a disegnare" + il nome dell'allegato di riferimento
- Colonna D (CORPO)= il corpo della mail, uguale per tutti
- Colonna E (ALLEGATO)= ho lasciato la colonna vuota, perchè non so in quale modo possa indicare dove prendere l'allegato.

Questa è la mia impostazione abbastanza banale, ma se avete altri suggerimenti sono ben lieto di ascoltarli.

Grazie mille a tutti in anticipo.

Ciaooo:)

di Grograman (utente non iscritto) data: 06/11/2014 10:04:24
Toh... a fagiuolo ho proprio un codice che fa più meno tutto ciò ^_^

Da adattare ai riferimenti del tuo file:

Option Explicit

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 sAddr As String, sBody As String, sObj As String, sFrom As String, sAttc As String
  Dim oOUT As Outlook.Application
  Dim oML As MailItem
  Dim x As Long, i As Long
  Dim ws As Worksheet
  
  Set ws = ThisWorkbook.Worksheets("Email")
  x = ws.Range("B" & ws.Rows.Count).End(xlUp).Row
  
  Set oOUT = CreateObject("Outlook.Application")
  For i = 6 To x
  
    sAddr = Cells(i, 3) 'Destinatario
    sObj = Cells(i, 4) 'Oggetto
    sBody = Cells(i, 5) 'Testo
    sAddr = Cells(i, 6) 'Allegato
    sFrom = Cells(i, 2) 'Mittente
    
    Set oML = oOUT.CreateItem(olMailItem)
    With oML
      .Attachments.Add sAttc
      .To = sAddr
      .Subject = sObj
      .Body = sBody
      '.SentOnBehalfOfName = sFrom
      .Display
      '.Send
    End With
  Next i
  Set oOUT = Nothing
  Set oML = Nothing
  Set ws = Nothing
End Sub

di Alex (utente non iscritto) data: 06/11/2014 11:01:36
Ciao Grograman,

prima di tutto grazie per la risposta, anche se sto provando a fare diversi tentativi ma la macro non gira.
Piuttosto, potresti inviarmi l'impostazione del tuo file excel, così creo un database su quell'impostazione e sono sicuro che la macro girerebbe?

di Grograman (utente non iscritto) data: 06/11/2014 11:04:47
Ciao!

Siccome ho visto che il codice era poco chiaro, lo stavo rivedendo, tendando anche di ottimizzarlo.
A quel punto l'ho adattattato direttamente sul tuo file... così siam contenti in due!

on è perfetot ancora, mi manca di capire come rendere visibile outlook in caso l'utente NON l'abbia aperto quando lancia la macro.

p.s. l'allegato l'ho indicato (senza le virgolette) nelle relative celle come "C:ProveFile di prova.xlsx"

Option Explicit
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 sTO As String, sCC As String, sBody As String, sObj As String, sFrom As String, sAttc As String
  Dim oOUT As Outlook.Application
  Dim oML As MailItem
  Dim x As Long, I As Long
  Dim ws As Worksheet
  Dim oExp As Explorer
      
  ''SE GIA' APERTO UTILIZZO LA SESSIONE ESISTENTE DI OUTLOOK ALTRIMENTI LO APRO
  On Error Resume Next
  Set oOUT = GetObject(, "Outlook.Application")
  If oOUT Is Nothing Then
    Set oOUT = CreateObject("Outlook.Application")
  End If
  On Error GoTo 0
  
  Set ws = ThisWorkbook.Worksheets("Foglio1")
  With ws
    x = .Range("A" & .Rows.Count).End(xlUp).Row
    
    'CICLO CELLE E MANDO AD OGNI INDIRIZZO UNA MAIL
    For I = 2 To x
      sTO = .Cells(I, 1) 'Destinatario
      sCC = .Cells(I, 2) 'Copia Conoscenza
      sObj = .Cells(I, 3) 'Oggetto
      sBody = "Il testo di questa mail è:" & Chr(13) & .Cells(I, 4)   'Testo
      sAttc = .Cells(I, 5) 'Allegato
      'sFrom = .Cells(i, 2) 'Mittente in caso si voglia modificare tra quelli disponibili in outlook
       
      Set oML = oOUT.CreateItem(olMailItem)
      With oML
        .To = sTO 'Destinatario
        .CC = sCC 'Copia Conoscenza
        .BCC = "" 'Copia Nascosta
        
        'CONTROLLO SU ESISTENZA FILE DA ALLEGARE
        If Dir(sAttc) <> "" Then
          .Attachments.Add sAttc 'Allegato
        Else
          sBody = sBody & Chr(13) & "ALLEGATO " & Chr(34) & ws.Cells(I, 5) & Chr(34) & " NON TROVATO!"
        End If
        
        .Subject = sObj 'Oggetto
        .Body = sBody 'Testo della mail
        '.SentOnBehalfOfName = sFrom 'Mittente in caso si voglia modificare tra quelli disponibili in outlook
        .Display 'omettere se non si vogliono visualizzare tutte le mail
        '.Send 'attivare se si vogliono inviare
      End With
    Next I
  End With
  Set oOUT = Nothing
  Set oML = Nothing
  Set ws = Nothing
End Sub

di Fabio (utente non iscritto) data: 06/11/2014 13:37:00
Buongiorno e scusate se mi intrometto.....
trovo molto utile questo argomento che però mi servirebbe con la versione 2003.
Naturalmente mi blocca perchè non trova la libreria.
Ho cercato nei Riferimento e ho trovato MICROSOFT OUTLOOK 11.0 OBJECT LIBRARY ma se la seleziono e la confermo mi segnala "Nome già utilizzato per modulo, progetto o libreria degli oggetti esistenti".
C'è la possibilità di risolvere il problema?
Grazie mille.
di Grograman (utente non iscritto) data: 06/11/2014 14:14:01
Hai preventivamente disabilitato la library 14.0 prima di attivare la 11? ;)

Peso che oggetti e metodi utilizzati in quel codice siano compatibili.
di Fabio (utente non iscritto) data: 06/11/2014 14:33:34
ho creato un nuovo file per evitare conflitti e ora funziona perfettamente con la librery 11.
L'unica cosa, anche se marginale, outlook mi segnala che sta inviando una email e mi chiede la conferma.
E' possibile eliminare questa conferma?
Grazie ancora
di mb (utente non iscritto) data: 06/11/2014 14:44:08
buongiorno
io non ho oultook ma utilizzo outlook express

come dovrei modificare
Dim oOUT As Outlook.Application

per poterlo utilizzare con il mio sistema di invio delle mail

grazie
di Grograman (utente non iscritto) data: 06/11/2014 16:02:29
Ciao emmebi!

Mi spiace, ma mi sa che non si può :(

Ho cercato un pò in rete, ma in due forum ho letto che non è utilizzabile per automatismi VBA Outlook Express :(
Speriamo qualcun altro mi smentisca!
di Alex (utente non iscritto) data: 07/11/2014 11:44:30
Caro Grograman, tu sei semplicemente un genio!!!
Ti ringrazio tantissimo.
Ad ogni modo non metto "risolta" alla domanda perchè forse avrò da porti qualche altra domanda residuale tra qualche giorno.

Grazie ancora molte, sei stato gentilissimo!!!!
Ciao!!!:)

di Grograman (utente non iscritto) data: 07/11/2014 12:28:52
Eh eh non esageriamo, siam qui tutti per imparare, chi più chi meno :P

Ad ogni modo ho modificato ulteriormente, sempre per studiarmi la libreria, in modo da evidenziare in grassetto il nome del file in caso non sia presente.

La parte in cui dovrebbe anche colorare il nome non è funzionante invece...

Option Explicit
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 sTO As String, sCC As String, sBody As String, sObj As String, sFrom As String, sAttc As String
  Dim oOUT As Outlook.Application
  Dim oML As MailItem
  Dim x As Long, I As Long
  Dim ws As Worksheet
  Dim bAllegato As Boolean
      
  ''SE GIA' APERTO UTILIZZO LA SESSIONE ESISTENTE DI OUTLOOK ALTRIMENTI LO APRO
  On Error Resume Next
  Set oOUT = GetObject(, "Outlook.Application")
  If oOUT Is Nothing Then
    Set oOUT = CreateObject("Outlook.Application")
  End If
  On Error GoTo 0
  
  Set ws = ThisWorkbook.Worksheets("Foglio1")
  With ws
    x = .Range("A" & .Rows.Count).End(xlUp).Row
    
    'CICLO CELLE E MANDO AD OGNI INDIRIZZO UNA MAIL
    For I = 2 To x
    ''''''''''''INDIVIDUO ELEMENTI DELLA MAIL''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
      sTO = .Cells(I, 1) 'Destinatario
      sCC = .Cells(I, 2) 'Copia Conoscenza
      sObj = .Cells(I, 3) 'Oggetto
      sBody = "Il testo di questa mail è:" & Chr(13) & .Cells(I, 4)   'Testo
      'sFrom = .Cells(i, 2) 'Mittente in caso si voglia modificare tra quelli disponibili in outlook
      
      'CONTROLLO SU ESISTENZA FILE DA ALLEGARE
      sAttc = .Cells(I, 5) 'Allegato
      If Dir(sAttc) <> "" Then
        bAllegato = True
      Else
        bAllegato = False
      End If
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''


    ''''''''''''''CREO LA MAIL E UTILIZZO LE INFORMAZIONI RACCOLTE SOPRA''''''''''''''''''''''''''''''''''''''''
      Set oML = oOUT.CreateItem(olMailItem)
      With oML
        .To = sTO 'Destinatario
        .CC = sCC 'Copia Conoscenza
        .BCC = "" 'Copia Nascosta
        .Subject = sObj 'Oggetto
                
        'SE ESISTE IL FILE DA ALLEGARE LO INSERISCO NELLA MAIL, ALTRIMENTI PASSO A CODICE HTML PER EVIDENZIARE ASSENZA
        If bAllegato Then
          .Attachments.Add sAttc         'Allegato
          .Body = sBody 'Testo della mail
        Else
          sBody = Replace(sBody, Chr(13), "
") & "
" & "ALLEGATO " & Chr(34) & "" & _
                  UCase(ws.Cells(I, 5)) & "" & Chr(34) & " NON TROVATO!"
          .HTMLBody = sBody
        End If
        
        '.SentOnBehalfOfName = sFrom 'Mittente in caso si voglia modificare tra quelli disponibili in outlook
        .Display 'omettere se non si vogliono visualizzare tutte le mail
        '.Send 'attivare se si vogliono inviare
      ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
      End With
      Set oML = Nothing
    Next I
  End With
  Set oOUT = Nothing
  Set oML = Nothing
  Set ws = Nothing
End Sub

Vuoi Approfondire?