Macro x invio e-mail

Hai un problema con Excel?

Nuova discussione

Macro x invio e-mail
di Antony_123 data: 11/04/2011
Ciao a tutti, ho urgenza di risolvere questo problema:
dovrei spedire delle e-mail pescando le informazioni da fogli di excel, qualche e-mail ha un allegato qualcuna no. se la cella è vuota non invia nulla. il problema è che se invio una e-mail che ha l'allegato la seconda tiene in memoria l'allegato, vedifica se sulla seconda e-mail ci deve essere e se c'è lo accoda al primo. come faccio a resettare il campo allegati ogni volta che parte una macro?
grazie a tutti in anticipo.

Sub Invia_email1()
    Dim AWorksheet As Worksheet
    Dim Sendrng As Range
    Dim rng As Range
    destinatario = Worksheets("V1").Cells(14, 3).Value
    allegato = Worksheets("V1").Cells(15, 12).Value
    On Error GoTo StopMacro
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With
    Set Sendrng = Worksheets("V1").Range("A1:K57")
    Set AWorksheet = ActiveSheet
    With Sendrng
        .Parent.Select
        Set rng = ActiveCell
        .Select
        ActiveWorkbook.EnvelopeVisible = True
        With .Parent.MailEnvelope
            With .Item
                .To = destinatario
                .CC = ""
                .BCC = ""
                .Subject = "VOUCHER"
                If allegato <> "" Then .Attachments.Add allegato
                .Send
            End With
        End With
        rng.Select
    End With
    AWorksheet.Select
StopMacro:
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
    ActiveWorkbook.EnvelopeVisible = False
    Sheets("VOUCHER").Select
End Sub


Sub Invia_email2()
    Dim AWorksheet As Worksheet
    Dim Sendrng As Range
    Dim rng As Range
    Dim OutApp As Object
    Dim OutMail As Object
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
    destinatario = Worksheets("V2").Cells(14, 3).Value
    allegato = Worksheets("V2").Cells(15, 12).Value
    On Error GoTo StopMacro
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With
    Set Sendrng = Worksheets("V2").Range("A1:K57")
    Set AWorksheet = ActiveSheet
    With Sendrng
        .Parent.Select
        Set rng = ActiveCell
        .Select
        ActiveWorkbook.EnvelopeVisible = True
        With .Parent.MailEnvelope
            With .Item
                .To = destinatario
                .CC = ""
                .BCC = ""
                .Subject = "VOUCHER"
                If allegato <> "" Then .Attachments.Add allegato
               .Send
            End With
        End With
        rng.Select
    End With
    AWorksheet.Select
StopMacro:
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
    ActiveWorkbook.EnvelopeVisible = False
    Sheets("VOUCHER").Select
    Set OutMail = Nothing
    Set OutApp = Nothing
End Sub

Vuoi Approfondire?