invio email in excel senza outlook

Question

Salve a tutti,

tra gli esempi che ho visionato non ho trovato niente che possa fare al mio caso.

Con Excel 2010 ho creato un programma di fatturazione che a fine mese mi stampa o salva in PDF le fatture che devo spedire via email, il problema è che non uso Outlook ma apro la posta con Explorer.

ho provato ad impostare decine di esempi senza riuscire a risolvere niente.

Allego una foto del foglio di lavoro da cui cerco di spedirle per spiegare quello che sto cercando di fare, nell'area Q4:AG4 ho i dati del cliente e nella cella AC2 quelli da cui spedisco l'email.

Grazie

Roberto

 

Answer 1

Ciao Roberto,

La macro funziona alla perfezione,

Bene! Mi fa piacere che funziona.

sto mettendo a confronto i vari esempi per capire meglio la modalità di programmazione e imparare qualcosa di più, ma non mi è facile,

Bravo! In questo modo si impara! 

inoltre sto cercando di cambiare l'impostazione della visualizzazione nel body della mail, come ad esempio mettere l'immagine sotto la dicitura ma non ci riesco, ho provato a cambiare l'ordine delle istruzione ma non risolvo niente.

ma sono sicuro che prima o poi ci riuscirò

Nel caso che dovesse essere poi anziché prima, potresti voler provare la seguente versione:

'=========>>

Option Explicit

'--------->>

Public Sub EmailConImmagineSottoFirma()

    Dim OutApp As Object

    Dim OutMail As Object

    Dim WB As Workbook

    Dim SH As Worksheet

    Dim rCell As Range

    Dim Rng As Range

    Dim sStr As String, aStr As String, sImmagine As String

    Dim LRow As Long

    Const sPercorsoFileImmagine ="C:\AB\FOTO" '<<=== Modifica

    Const sFileImmagine ="Logo.jpg" '<<=== Modifica

    Const sFoglio As String = "FE"                                           '<<=== Modifica

    Set WB = ThisWorkbook

    Set SH = WB.Sheets(sFoglio)

    With SH

        LRow = LastRow(SH, .Columns("AC:AC"))

        Set Rng = .Range("AC4:AC" & LRow)

    End With

    sImmagine = "'" & sPercorsoFileImmagine & sFileImmagine & "'"

    For Each rCell In Rng.Cells

        If rCell.Value Like "?*@?*.?*" Then

            Set OutApp = CreateObject("Outlook.Application")

            Set OutMail = OutApp.CreateItem(0)

            On Error Resume Next

            With OutMail

                .Display                                         '<<=== NON modifica!!

                .To = rCell.Value    

                .CC = ""

                .BCC = ""

                .Subject = rCell.Offset(0, 3).Value 

                aStr = rCell.Offset(0, 4).Value & Space(1) _

                     & rCell.Offset(0, -1).Value

                .HTMLBody = aStr & "<br>" & .HTMLBody

                .HTMLBody = .HTMLBody & "<HTML><img src=" _

                          & sImmagine & " alt='' width=300 height=300></HTML>"

                .Display

            End With

            Set OutMail = Nothing

        End If

    Next rCell

XIT:

    On Error GoTo 0

    Set OutMail = Nothing

    Set OutApp = Nothing

End Sub

'--------->>

Public Function LastRow(SH As Worksheet, _

                        Optional Rng As Range)

    If Rng Is Nothing Then

        Set Rng = SH.Cells

    End If

    On Error Resume Next

    LastRow = Rng.Find(What:="*", _

                       after:=Rng.Cells(1), _

                       Lookat:=xlPart, _

                       LookIn:=xlFormulas, _

                       SearchOrder:=xlByRows, _

                       SearchDirection:=xlPrevious, _

                       MatchCase:=False).Row

    On Error GoTo 0

End Function

'<<=========

Visto che abbiamo viaggiato abbastanza lontano dall'ambito della tua domanda iniziale,  e che ad ogni passo, hai riconosciuto ciascun codice diverso come pienamente rispondente alla domanda in questione, al fine di chiudere questo thread, vorrei gentilmente chiederti di segnare la risposta, o le risposte rilevante come Risposta. In questo modo, tu aiuterai anche coloro che potrebbero cercare soluzioni ai problemi simili negli archivi della Community. 

Se questo thread dovesse ispirare altre strade di codice o altre domande, saremo lieti di rispondere a eventuali nuovi thead.

Alla prossima.

===

Regards,

Norman

Answer 2

Grazie David, ho raggiunto il mio obiettivo.

L'ultima versione della macro è molto diversa da quella precedente nonostante facciano correttamente lo stesso lavoro con la differenza che mette il logo alla fine e non all'inizio del body. (mi studierò come sono articolate confrontandole).

Aprirò a breve un altro thread dove vorrei mettere a confronto delle operazioni che vengono molto spesso fatte con le vecchie Macro 4.0 che ho molta difficoltà a tradurre in VBA, anche perché credo che siano di un certo interesse per chi come me è abituato al vecchio linguaggio. 

Detto ciò possiamo chiudere il thread, 

Con molta gratitudine

Roberto Barcella

Answer 3

Ciao David,

La macro funziona alla perfezione,

sto mettendo a confronto i vari esempi per capire meglio la modalità di programmazione e imparare qualcosa di più, ma non mi è facile, inoltre sto cercando di cambiare l'impostazione della visualizzazione nel body della mail, come ad esempio mettere l'immagine sotto la dicitura ma non ci riesco, ho provato a cambiare l'ordine delle istruzione ma non risolvo niente.

ma sono sicuro che prima o poi ci riuscirò

Grazie ancora

Roberto

Answer 4

Ciao Roberto,

ho un po di problemi ad inserire un'immagine nel Body dell'email, ho cercato di inserire alcune istruzioni ma non ci riesco.

Vedi di sotto.

Dalla Foto che ho allego, quando la macro trova un indirizzo email mi carica correttamente l’allegato nella colonna AH ma non mi trova il Nome e il Testo che sono nella colonna Q e AG, so che le istruzioni che ho evidenziato sono errate, ma non riesco a inserire l’istruzione corretta.

A parte degli errori di sintassi, non hai utilizzato queste due variabili nel codice. Se vorresti fornire un esempio del 'layout' desiderato per le email e indicare dove queste due variabili dovrebbero essere utilizzate nelle email, io modificherò il codice.

Inoltre cerco di inserire nel corpo dell’email un’immagine ma non ci riesco

Sarebbe necessario sfruttare la proprieta HTMLBody di Outlook e di utilizzare i tag di html. Ho modificato il codice (vedi di sotto) per inserire l'immagine nelle email.

Quindi, prova qualcosa del genere:

'=========>>

Option Explicit

'--------->>

Public Sub SendPDF()

    Dim OutApp As Object

    Dim OutMail As Object

    Dim WB As Workbook

    Dim SH As Worksheet

    Dim rCell As Range

    Dim Rng As Range

    Dim sStr As String, aStr As String, sImmagine As String

    Dim LRow As Long

    Const sPercorsoFileImmagine ="C:\AB\FOTO"

    Const sFileImmagine ='"Logo.jpg"

    Const sFoglio As String = "FE"

    Set WB = ThisWorkbook

    Set SH = WB.Sheets(sFoglio)

    With SH

        LRow = LastRow(SH, .Columns("AC:AC"))

        Set Rng = .Range("AC4:AC" & LRow)

    End With

    sImmagine = "'" & sPercorsoFileImmagine & sFileImmagine & "'"

    Set OutApp = CreateObject("Outlook.Application")

    On Error GoTo XIT

    With Application

        .EnableEvents = False

        .ScreenUpdating = False

    End With

    For Each rCell In Rng.Cells

        If rCell.Value Like "?*@?*.?*" Then

            Set OutMail = OutApp.CreateItem(0)

            With OutMail

                .To = rCell.Value

                .Subject = rCell.Offset(0, 3).Value

  aStr = rCell.Offset(0, 4).Value & Space(1) _

& rCell.Offset(0, -1).Value

.HTMLBody = "<HTML><img src=" _

& sImmagine & " alt='' width=300 height=300></HTML>" _

& vbNewLine & aStr

                sStr = Trim(rCell.Offset(0, 5).Value)

                If sStr <> "" Then

                    If Dir(sStr) <> "" Then

                        .Attachments.Add sStr

                    End If

                End If

                .Display

            End With

            Set OutMail = Nothing

        End If

    Next rCell

XIT:

    Set OutApp = Nothing

    With Application

        .EnableEvents = True

        .ScreenUpdating = True

    End With

End Sub

'--------->>

Public Function LastRow(SH As Worksheet, _

                        Optional Rng As Range)

    If Rng Is Nothing Then

        Set Rng = SH.Cells

    End If

    On Error Resume Next

    LastRow = Rng.Find(What:="*", _

                       after:=Rng.Cells(1), _

                       Lookat:=xlPart, _

                       LookIn:=xlFormulas, _

                       SearchOrder:=xlByRows, _

                       SearchDirection:=xlPrevious, _

                       MatchCase:=False).Row

    On Error GoTo 0

End Function

'<<=========

===

Regards,

Norman

Answer 5

Ciao David,

ho un po di problemi ad inserire un'immagine nel Body dell'email, ho cercato di inserire alcune istruzioni ma non ci riesco.

Dalla Foto che ho allego, quando la macro trova un indirizzo email mi carica correttamente l’allegato nella colonna AH ma non mi trova il Nome e il Testo che sono nella colonna Q e AG, so che le istruzioni che ho evidenziato sono errate, ma non riesco a inserire l’istruzione corretta.

Inoltre cerco di inserire nel corpo dell’email un’immagine ma non ci riesco.

Grazie

Roberto

 

Option Explicit

____________________________________________

Public Sub SendPDF()

    Dim OutApp As Object

    Dim OutMail As Object

    Dim WB As Workbook

    Dim SH As Worksheet

    Dim rCell As Range

    Dim Rng As Range

    Dim sStr As String

    Dim LRow As Long

Dim Nome As String

Dim Testo As String

 Dim percorsofileimmagine As String

****Dim fileimmagine As String

****    Const sFoglio As String = "FE"

**** Nome = Cells.Offset(32, 32)

**** Testo = Cells.Offset(32, 17)

---

percorsofileimmagine = "C:\AB\FOTO"

fileimmagine = "Logo.jpg"

    Set WB = ThisWorkbook

    Set SH = WB.Sheets(sFoglio)

    With SH

        LRow = LastRow(SH, .Columns("AC:AC"))

        Set Rng = .Range("AC4:AC" & LRow)

    End With

    Set OutApp = CreateObject("Outlook.Application")

    On Error GoTo XIT

    With Application

        .EnableEvents = False

        .ScreenUpdating = False

    End With

    For Each rCell In Rng.Cells

        If rCell.Value Like "?*@?*.?*" Then

            Set OutMail = OutApp.CreateItem(0)

            With OutMail

                .To = rCell.Value

                .Subject = rCell.Offset(0, 3).Value

                .Body = rCell.Offset(0, 4).Value & Space(1) _

                      & rCell.Offset(0, -1).Value

                      & "<img src='" & fileimmagine & "'/>"

sStr = Trim(rCell.Offset(0, 5).Value)

                If sStr <> "" Then

                    If Dir(sStr) <> "" Then

                        .Attachments.Add sStr

                    End If

                End If

                .Display

            End With

            Set OutMail = Nothing

        End If

    Next rCell

XIT:

    Set OutApp = Nothing

    With Application

        .EnableEvents = True

        .ScreenUpdating = True

    End With

End Sub

__________________________________________

Public Function LastRow(SH As Worksheet, _

                        Optional Rng As Range)

    If Rng Is Nothing Then

        Set Rng = SH.Cells

    End If

    On Error Resume Next

    LastRow = Rng.Find(What:="*", _

                       after:=Rng.Cells(1), _

                       Lookat:=xlPart, _

                       LookIn:=xlFormulas, _

                       SearchOrder:=xlByRows, _

                       SearchDirection:=xlPrevious, _

                       MatchCase:=False).Row

    On Error GoTo 0

End Function