invio email in excel senza outlook

Anonimo

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

Domanda bloccata. Questa domanda è stata eseguita dalla community del supporto tecnico Microsoft. È possibile votare se è utile, ma non è possibile aggiungere commenti o risposte o seguire la domanda.

0 commenti

Risposta accettata dall'autore della domanda

Anonimo

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

0 commenti

13 risposte aggiuntive

Anonimo

2015-07-08T11:51:54+00:00

Ciao Roberto,

Meglio sarebbe la seguente versione:

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

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

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

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

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
La risposta è stata utile?

0 commenti Nessun commento
Anonimo

2015-07-08T11:44:59+00:00

Ciao Roberto,

Prova qualcosa del genere:

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

Option Explicit

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

Public Sub SendPDF()

Dim OutApp As Object

Dim OutMail As Object

Dim SH As Worksheet

Dim rCell As Range

Dim FileCell As Range

Dim Rng As Range

Dim sStr As String

Dim LRow As Long

Set SH = Sheets("FE")

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

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
La risposta è stata utile?

0 commenti Nessun commento
Anonimo

2015-07-08T08:07:52+00:00

ciao David, avevo già provato ad applicare molti degli esempi di Ron de Bruin ma con il CDO non riesco, ho comunque deciso temporaneamente di installare Outlook per adattare la seguente macro ma ho difficoltà ad assegnargli le celle dove ho inserito i dati delle email da spedire, ho messo in grassetto le istruzione che sicuramente non sono corrette.

Di ogni email che spedisco (usando una macro 4.0) copio i dati della lista in basso nelle celle AC4 (indirizzo email), AF4 (titolo), AG4 (descrizione), AH4 (path e nome del file.pdf), spedisco l'email e sostituisco i dati con la riga successiva fino alla fine, in modo che ad ogni email possa vedere l'anteprima per confermarla oppure annullarla.

Grazie Roberto

Sub SendPDF()

    Dim OutApp As Object

    Dim OutMail As Object

    Dim sh As Worksheet

    Dim cell As Range

    Dim FileCell As Range

    Dim rng As Range

    With Application

        .EnableEvents = False

        .ScreenUpdating = False

    End With

    Set sh = Sheets("FE")

    Set OutApp = CreateObject("Outlook.Application")

    For Each cell In sh.Columns("AC").Cells.SpecialCells(xlCellTypeConstants)

Set rng = sh.Cells(cell.Row, 1).Range("AH4")

        If cell.Value Like "?*@?*.?*" And _

           Application.WorksheetFunction.CountA(rng) > 0 Then

            Set OutMail = OutApp.CreateItem(0)

            With OutMail

                .To = cell.Value

              .Subject = ("AF4")

              .Body = ("AG4") & cell.Offset(0, -1).Value

                For Each FileCell In rng.SpecialCells(xlCellTypeConstants)

                    If Trim(FileCell) <> "" Then

                        If Dir(FileCell.Value) <> "" Then

                            .Attachments.Add FileCell.Value

                        End If

                    End If

                Next FileCell

                .Display

                .Send

            End With

            Set OutMail = Nothing

        End If

    Next cell

    Set OutApp = Nothing

    With Application

        .EnableEvents = True

        .ScreenUpdating = True

    End With

End Sub
La risposta è stata utile?

0 commenti Nessun commento
Anonimo

2015-07-07T00:33:59+00:00

Ciao Roberto,

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.

[....]

Prova di usare CDO (Collaboration Data Objects), Al questo riguardo, vedi la pagina Sending mail from Excel with CDO di Ron de Bruin:

http://www.rondebruin.nl/win/s1/cdo.htm

Oltre al codice e i suggerimenti che troverai lì, potresti anche scaricare una cartella di lavoro con numerosi altri esempi di codice.

Dovresti inizialmente verificare che il tuo PC sia in grado di sfruttare CDO. A questo proposito vedi il paragrafo intitolato:

Can you use CDO on your machine? (paragrafo #7)

e prova il codice di test suggerito da Ron.

Se, dopo aver verificato questo, dovresti aver bisogno di aiuto per adattare il codice, noi saremo qui!

===

Regards,

Norman
La risposta è stata utile?

0 commenti Nessun commento