Notizie: scarica ora l'ultima versione disponibile di Firefox!

Autore Topic: macro MS excel - thunderbird invio mail con allegati diversi  (Letto 1424 volte)

0 Utenti e 1 Visitatore stanno visualizzando questo topic.

Offline pablito2903

  • Post: 1
Buongiorno, prima di tutto mi scuso essendo un neoarrivato e se la richiesta sarà al limite dell'offtopics trattando più argomenti ( vba excel TB ) ma ho il seguente problema e devo trovare il modo di risolverlo...: devo inviare ad una lunga serie di indirizzi di posta una mail ( il cui testo va bene anche non personalizzato ma se lo fosse. meglio..) contenente in allegato un pdf relativo al soggetto che riceve la mail. Ho un foglio di excel nelle cui colonne sono presenti indirizzi mail, nome delle associazioni, indirizzo del file da allegare alla mail. Sono in tutto circa 500. In altri forum ho trovato una routine che potrebbe fare al caso mio ma è imostata per outlook ed io ho thunderbird 60.9.1 (32) e voglio\devo utilizzare questo . 

La routine per excel che ho trovato è questa, qualcuno saprebbe aiutarmi per capire come posso modificarla per farla lavorare con TB anzichè MS Outlook:

Codice: [Seleziona]

    Alt+F11 per aprire l'editor di VBA
    Alt+IM per inserire un nuovo modulo di codice
    Nel nuovo modulo vuoto, incolla il seguente codice: 

'=========>>
Option Explicit

'--------->>
Public Sub Tester()
    Dim WB As Workbook
    Dim SH As Worksheet
    Dim Rng As Range
    Dim arrIn As Variant
    Dim oOutlook As Object
    Dim oMail As Object
    Dim sIndirizzo As String
    Dim sNome As String
    Dim sCognome As String
    Dim sTitolo As String
    Dim sPercorso As String
    Dim sAllegato As String
    Dim LRow As Long, i As Long

    Const sFoglio As String = "Foglio1"                             '<<=== Modifica
    Const sOggetto As String = "Oggetto"           '<<=== Modifica
    Const sSalutazione As String = "Buon giorno "           '<<=== Modifica

    Set WB = ThisWorkbook
    Set SH = WB.Sheets(sFoglio)

    With SH
        LRow = LastRow(SH, .Columns("A:A"))
        Set Rng = .Range("A2:F" & LRow)
    End With
    arrIn = Rng.Value2

    Set oOutlook = CreateObject("Outlook.Application")
    For i = 1 To UBound(arrIn)
        Set oMail = oOutlook.CreateItem(0)
        With oMail
            sIndirizzo = arrIn(i, 1)
            sCognome = arrIn(i, 2)
            sNome = arrIn(i, 3)
            sTitolo = arrIn(i, 4)
            sPercorso = arrIn(i, 5)
            sAllegato = arrIn(i, 6)
            .To = sIndirizzo
            .CC = ""
            .BCC = ""
            .Subject = sOggetto
            .Body = sSalutazione & sTitolo & Space(1) _
                    & sNome & Space(1) & sCognome _
                    & vbNewLine & vbNewLine _
                    & "Alleghiamo il file " & sAllegato
            .Attachments.Add sPercorso _
                             & Application.PathSeparator _
                             & sAllegato
            .Send
        End With
        Set oMail = Nothing
    Next i

    Set oMail = Nothing
    Set oOutlook = Nothing
End Sub

'--------->>
Public Function LastRow(SH As Worksheet, _
                        Optional Rng As Range, _
                        Optional minRow As Long = 1, _
                        Optional sPassword As String)
    Dim bProtected As Boolean

    With SH
        If Rng Is Nothing Then
            Set Rng = .Cells
        End If
        bProtected = .ProtectContents = True
        If bProtected Then
            Application.ScreenUpdating = False
            .Unprotect Password:=sPassword
        End If
    End With
    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
    If LastRow < minRow Then
        LastRow = minRow
    End If

    If bProtected Then
        SH.Protect Password:=sPassword, _
                   UserInterfaceOnly:=True
    End If
    Application.ScreenUpdating = True
End Function
'<<=========

    Alt+Q per chiudere l'editor di VBA e tornare a Excel
    Salva il file con l’estensione xlsm
    Alt+F8 per aprire  la finestra di gestione delle macro
    Seleziona Tester
    Esegui
« Ultima modifica: 07 Dicembre 2019 18:22:07 da miki64 »

Offline deckard

  • Post: 3667
Re:macro MS excel - thunderbird invio mail con allegati diversi
« Risposta #1 il: 06 Dicembre 2019 22:33:17 »
Buona sera, se devi inviare ad una lunga serie di indirizzi di posta una mail c'è la possibilità di farlo tramite componenti aggiuntivi come Mail Merge, ma dubito seriamente che ci sia la possibilità di farlo tramite Macro Excel...

0 Utenti e 1 Visitatore stanno visualizzando questo topic.