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