Automaticamente spedire email basato nel valore di celle

Question

Ciao a tutti,

Ho trovato online il codice allegato di sotto. Praticamente devi selezionare le celle ed eseguire la macro che manda un email con quelle celle nel corpo del mail.

Avrei bisogno di una funzione più specifica. Non so se e possibile e chiedo il vostro aiuto:

Ogni volta che una cella nella colona H viene compilata (cioè non e' più vuota) Excel deve mandare un email con la linea specifica, cioè se compiliamo la cella H24, deve includere i dati A24:L24

Il codice che ho trovato: https://www.dropbox.com/s/jv4tq47hm1skt67/Module3.bas?dl=0

Answer 1

Ciao AurEl3,

Grandissimo!

E' possibile aggiungere del testo al body?

Ho provato come nel screenshot ma non cambia niente.

Si vede che e controlato dal .HTMLBody ed io non so come impostare.

Sostituisci il codice nel modulo di codice standard con:

'========>>

Option Explicit

'-------->>

Public Sub Mail_Selection_Range_Outlook_Body(Rng As Range)

'For Tips see: http://www.rondebruin.nl/win/winmail/Outlook/tips.htm

'Don't forget to copy the function RangetoHTML in the module.

'Working in Excel 2000-2016

    Dim OutApp As Object

    Dim OutMail As Object

    With Application

        .EnableEvents = False

        .ScreenUpdating = False

    End With

    Set OutApp = CreateObject("Outlook.Application")

    Set OutMail = OutApp.CreateItem(0)

    On Error Resume Next

    With OutMail

        .To = "@outlook.com" ' "@lfeeng.co.uk"

        .CC = ""

        .BCC = ""

        .Subject = "This is the Subject line"

        .HTMLBody = "Hi Danny   Please update the Factory Master data for the order below:" & RangetoHTML(Rng)

        .Display  'or use .Display

    End With

    On Error GoTo 0

    With Application

        .EnableEvents = True

        .ScreenUpdating = True

    End With

    Set OutMail = Nothing

    Set OutApp = Nothing

End Sub

'-------->>

Public Function RangetoHTML(Rng As Range)

' Changed by Ron de Bruin 28-Oct-2006

' Working in Office 2000-2016

    Dim fso As Object

    Dim ts As Object

    Dim TempFile As String

    Dim TempWB As Workbook

    TempFile = Environ$("temp") & "" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"

    'Copy the range and create a new workbook to past the data in

    Rng.Copy

    Set TempWB = Workbooks.Add(1)

    With TempWB.Sheets(1)

        .Cells(1).PasteSpecial Paste:=8

        .Cells(1).PasteSpecial xlPasteValues, , False, False

        .Cells(1).PasteSpecial xlPasteFormats, , False, False

        .Cells(1).Select

        Application.CutCopyMode = False

        On Error Resume Next

        .DrawingObjects.Visible = True

        .DrawingObjects.Delete

        On Error GoTo 0

    End With

    'Publish the sheet to a htm file

    With TempWB.PublishObjects.Add( _

         SourceType:=xlSourceRange, _

         Filename:=TempFile, _

         Sheet:=TempWB.Sheets(1).Name, _

         Source:=TempWB.Sheets(1).UsedRange.Address, _

         HtmlType:=xlHtmlStatic)

        .Publish (True)

    End With

    'Read all data from the htm file into RangetoHTML

    Set fso = CreateObject("Scripting.FileSystemObject")

    Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)

    RangetoHTML = ts.readall

    ts.Close

    RangetoHTML = Replace(RangetoHTML, "align=center x:publishsource=", _

                          "align=left x:publishsource=")

    'Close TempWB

    TempWB.Close savechanges:=False

    'Delete the htm file we used in this function

    Kill TempFile

    Set ts = Nothing

    Set fso = Nothing

    Set TempWB = Nothing

End Function

'<<========

===

Regards,

Norman

Answer 2

Ciao AurEl3,

Ho trovato online il codice allegato di sotto. Praticamente devi selezionare le celle ed eseguire la macro che manda un email con quelle celle nel corpo del mail.

Avrei bisogno di una funzione più specifica. Non so se e possibile e chiedo il vostro aiuto:

Ogni volta che una cella nella colona H viene compilata (cioè non e' più vuota) Excel deve mandare un email con la linea specifica, cioè se compiliamo la cella H24, deve includere i dati A24:L24

Il codice che ho trovato: https://www.dropbox.com/s/jv4tq47hm1skt67/Module3.bas?dl=0

• Fai clic dx sulla linguetta del foglio di interesse
• Seleziona l'opzione Visualizza Codice dal **** menu contestuale risultante
• Incolla il seguente codice:

'========>>

Option Explicit

'-------->>

Private Sub Worksheet_Change(ByVal Target As Range)

Dim Rng As Range, RngOut As Range, rCell As Range 

Const sColonna\_di\_Modifica As String = "H" 

Set Rng = Intersect(Me.Columns(sColonna\_di\_Modifica), Target)  

If Not Rng Is Nothing Then 

    For Each rCell In Rng.Cells 

        With rCell 

            If Not IsEmpty(.Value) Then 

                Set RngOut = Intersect(.EntireRow, Me.Columns("A:L")) 

                DoEvents 

                Call Mail\_Selection\_Range\_Outlook\_Body(RngOut) 

                DoEvents 

            End If 

        End With 

    Next rCell 

End If 

End Sub

'<<========

Nel tuo modulo di codice Module3, sostituisci il tuo codice con:

'========>>

Option Explicit

'-------->>

Public Sub Mail_Selection_Range_Outlook_Body(Rng As Range)

'For Tips see: http://www.rondebruin.nl/win/winmail/Outlook/tips.htm

'Don't forget to copy the function RangetoHTML in the module.

'Working in Excel 2000-2016

    Dim OutApp As Object

    Dim OutMail As Object

    With Application

        .EnableEvents = False

        .ScreenUpdating = False

    End With

    Set OutApp = CreateObject("Outlook.Application")

    Set OutMail = OutApp.CreateItem(0)

    On Error Resume Next

    With OutMail

        .To = "aurel.e AT pippo.com " '<<=== Modifica !

        .CC = ""

        .BCC = ""

        .Subject = "This is the Subject line"

        .HTMLBody = RangetoHTML(Rng)

        .Display  'or use .Display

    End With

    On Error GoTo 0

    With Application

        .EnableEvents = True

        .ScreenUpdating = True

    End With

    Set OutMail = Nothing

    Set OutApp = Nothing

End Sub

'-------->>

Public Function RangetoHTML(Rng As Range)

' Changed by Ron de Bruin 28-Oct-2006

' Working in Office 2000-2016

    Dim fso As Object

    Dim ts As Object

    Dim TempFile As String

    Dim TempWB As Workbook

    TempFile = Environ$("temp") & "" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"

    'Copy the range and create a new workbook to past the data in

    Rng.Copy

    Set TempWB = Workbooks.Add(1)

    With TempWB.Sheets(1)

        .Cells(1).PasteSpecial Paste:=8

        .Cells(1).PasteSpecial xlPasteValues, , False, False

        .Cells(1).PasteSpecial xlPasteFormats, , False, False

        .Cells(1).Select

        Application.CutCopyMode = False

        On Error Resume Next

        .DrawingObjects.Visible = True

        .DrawingObjects.Delete

        On Error GoTo 0

    End With

    'Publish the sheet to a htm file

    With TempWB.PublishObjects.Add( _

         SourceType:=xlSourceRange, _

         Filename:=TempFile, _

         Sheet:=TempWB.Sheets(1).Name, _

         Source:=TempWB.Sheets(1).UsedRange.Address, _

         HtmlType:=xlHtmlStatic)

        .Publish (True)

    End With

    'Read all data from the htm file into RangetoHTML

    Set fso = CreateObject("Scripting.FileSystemObject")

    Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)

    RangetoHTML = ts.readall

    ts.Close

    RangetoHTML = Replace(RangetoHTML, "align=center x:publishsource=", _

                          "align=left x:publishsource=")

    'Close TempWB

    TempWB.Close savechanges:=False

    'Delete the htm file we used in this function

    Kill TempFile

    Set ts = Nothing

    Set fso = Nothing

    Set TempWB = Nothing

End Function

'<<========

===

Regards,

Norman

Answer 3

Grazie di nuovo,

Il codice addesso va.

Solo che vorrei possibilmente cambiare.

Nel range da copiare vorrei includere anche le intestazioni delle colone.

Pratticamente non solo la linea per esempio A24:L24 ma anche la A1:L1 sopra.

L'email com'e' addesso si presenta cosi':

Io vorrei averlo come la screenshot di sotto:

Answer 4

Ciao AurEl3,

Grazie Norman

ho provato, ma mi da un errore. Allego screenshot:

Questo è un problema creato dalla versione corrente dell'editor del forum: l'editor inserisce una riga vuota estranea dopo ogni carattere di interruzione di riga. Pertanto, elimina la riga vuota dopo ogni riga di codice che è evidenziata in rosso.

In alternativa, scarica e importa il mio modulo di codice Revised_Code.bas

===

Regards,

Norman

Answer 5

Grazie Norman

ho provato, ma mi da un errore. Allego screenshot: