macro ... errore selezione allegato.

Anonimo
2019-12-03T19:51:28+00:00

Buonasera a tutti,

sto cercando di inviare allegati diversi da diversi destinatari. Gli allegati da inviare sono diversi per ogni mail. Ho inserito dunque una colonna (i,5) con il nome del pdf —> 17ab033.pdf mentre nella colonna (i, 21) il percorso —> C:\Users\Andrea\Desktop\OFFERTE 2020\ .

Vorrei che ogni volta venga allegato il file della riga selezionata indicato dal percorso e dal nome del pdf. 

Di seguito il codice:

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

''''' 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

inizio = InputBox("Inserisci numero riga di inizio.")

fine = InputBox("Inserisci numero riga di fine.")

  ''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("REPORT")

  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, 4) 'Destinatario

      sCC = "******@labet.it" 'Copia Conoscenza

      sObj = .Cells(i, 5) 'Oggetto

      sPercorso = .Cells(i, 21) 'Percorso

      sBody = "Buongiorno Sig." & .Cells(i, 3) & Chr(13) & .Cells(i, 17) 'Testo

      sAllegato = .Cells(i, 5)

      Set oML = oOUT.CreateItem(olMailItem)

      With oML

        .To = sTO 'Destinatario

        .CC = sCC 'Copia Conoscenza

        .BCC = "" 'Copia Nascosta

        .Subject = sObj 'Oggetto

        .Body = sBody 'Testo della mail

        .Attachments.Add ("C:\Users\Andrea\Desktop\OFFERTE 2020\17ab033.pdf")

        .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

Vi ringrazio in anticipo.

Microsoft 365 e Office | Excel | Per la casa | Windows

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

1 risposta

Ordina per: Più utili
Più utili Più recente Meno recente
  1. Anonimo
    2019-12-03T23:44:05+00:00

    Ciao Andrea,,

    sto cercando di inviare allegati diversi da diversi destinatari. Gli allegati da inviare sono diversi per ogni mail. Ho inserito dunque una colonna (i,5) con il nome del pdf —> 17ab033.pdf mentre nella colonna (i, 21) il percorso —> C:\Users\Andrea\Desktop\OFFERTE 2020\ .

    Vorrei che ogni volta venga allegato il file della riga selezionata indicato dal percorso e dal nome del pdf. 

    Di seguito il codice:

    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

    ''''' 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

    inizio = InputBox("Inserisci numero riga di inizio.")

    fine = InputBox("Inserisci numero riga di fine.")

      ''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("REPORT")

      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, 4) 'Destinatario

          sCC = "*** L'indirizzo di posta elettronica viene rimosso per motivi di privacy ***" 'Copia Conoscenza

          sObj = .Cells(i, 5) 'Oggetto

          sPercorso = .Cells(i, 21) 'Percorso

          sBody = "Buongiorno Sig." & .Cells(i, 3) & Chr(13) & .Cells(i, 17) 'Testo

          sAllegato = .Cells(i, 5)

          Set oML = oOUT.CreateItem(olMailItem)

          With oML

            .To = sTO 'Destinatario

            .CC = sCC 'Copia Conoscenza

            .BCC = "" 'Copia Nascosta

            .Subject = sObj 'Oggetto

            .Body = sBody 'Testo della mail

            .Attachments.Add ("C:\Users\Andrea\Desktop\OFFERTE 2020\17ab033.pdf")

            .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

    Vi ringrazio in anticipo.

    Prova qualcosa del genere:

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

    Option Explicit

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

    Public Sub Tester()

        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

        Dim sPercorso As String, sAllegato As String

        Dim inizio As Long, fine As Long 'String

        '  inizio = InputBox("Inserisci numero riga di inizio.")

        '  fine = InputBox("Inserisci numero riga di fine.")

        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("REPORT")

        With ws

            x = .Range("A" & .Rows.Count).End(xlUp).Row

            For i = 2 To x

                sTO = .Cells(i, 4).Value

                sCC = "*** L'indirizzo di posta elettronica            '<<=== Modifica

                sObj = .Cells(i, 5).Value

                sPercorso = .Cells(i, 21).Value

                sBody = "Buongiorno Sig." & .Cells(i, 3).Value _

                        & Chr(13) & .Cells(i, 17).Value

                sAllegato = sPercorso _

                            & Application.PathSeparator _

                            & .Cells(i, 5).Value

                Set oML = oOUT.CreateItem(olMailItem)

                With oML

                    .To = sTO

                    .CC = sCC

                    .BCC = ""

                    .Subject = sObj    '

                    .Body = sBody

                    .Attachments.Add sAllegato

                    .Display  '\.Send

                End With

            Next i

        End With

        Set oOUT = Nothing

        Set oML = Nothing

        Set ws = Nothing

    End Sub

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

    ===

    Regards,

    Norman

    La risposta è stata utile?

    0 commenti