Discussione:
Inviare email con thunderbird
(troppo vecchio per rispondere)
Marco Augusto
2017-08-25 10:01:16 UTC
Permalink
Salve a tutti
ho questa semplice macro per inviare email con thunderbird da un foglio excel
Se il Range del testo email è una cella va tutto bene (esempio "A3")
Viceversa se il Range è come da esempio "A3:C16" da errore
Qualcuno sa e può aiutarmi ?
Grazie in anticipo per la collaborazione


Sub sendmail()
Dim BodyMsg As String, Indirizzo As String, Oggetto As String
BodyMsg = Range("A3:C16").Value
Indirizzo = Range("A1").Value
Oggetto = Range("A2").Value
Shell "C:\Program Files (x86)\Mozilla Thunderbird\thunderbird -compose " _
& Chr$(34) & "to='" & Indirizzo & "',subject='" & Oggetto & "',body='" & BodyMsg _
& Chr$(34), vbNormalFocus
Application.Wait Now + TimeValue("00:00:03")
SendKeys "^{ENTER}"
End Sub
Norman Jones
2017-08-25 10:48:08 UTC
Permalink
Ciao Marco,
Post by Marco Augusto
Salve a tutti
ho questa semplice macro per inviare email con thunderbird da un foglio excel
Se il Range del testo email è una cella va tutto bene (esempio "A3")
Viceversa se il Range è come da esempio "A3:C16" da errore
Qualcuno sa e può aiutarmi ?
Grazie in anticipo per la collaborazione
Sub sendmail()
Dim BodyMsg As String, Indirizzo As String, Oggetto As String
BodyMsg = Range("A3:C16").Value
Indirizzo = Range("A1").Value
Oggetto = Range("A2").Value
Shell "C:\Program Files (x86)\Mozilla Thunderbird\thunderbird -compose " _
& Chr$(34) & "to='" & Indirizzo & "',subject='" & Oggetto & "',body='" & BodyMsg _
& Chr$(34), vbNormalFocus
Application.Wait Now + TimeValue("00:00:03")
SendKeys "^{ENTER}"
End Sub
Prova la seguente leggera modifica del codice suggerito a:
www.experts-exchange.com/questions/26517936/vba-to-send-excel-range-by-email-through-thunderbird.html

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

'--------->>
Public Sub tbSendMaster()
Dim WB As Workbook
Dim SH As Worksheet
Dim RngBodyMsg As Range, RngIndirizzo As Range
Dim RngOggetto As Range
Dim sIndirizzo As String, sOggetto As String

Const sFoglio As String = "Foglio1"
Const sIntervalloBodyMsg As String = "A3:C16"
Const sIntervalloIndirizzo As String = "A1"
Const sIntervalloOggetto As String = "A2"
Const sIntestazioneBody As String = "Vede il seguenti dati"

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

With SH
Set RngBodyMsg = .Range(sBodyMsg)
Set RngIndirizzo = .Range(sIndirizzo)
Set RngOggetto = .Range(sOggetto)
End With

sIndirizzo = RngIndirizzo.Value
sOggetto = RngOggetto.Value

TB_MailSend sIndirizzo, sOggetto, sIntestazioneBody _
& "%0D%0A" & "%0D%0A" _
& rng2text(RngBodyMsg) _
& "%0D%0A" & "Endex"
End Sub

'--------->>
Public Function TB_MailSend(strTo As String, strSubject As String,
strBody As String)
Dim str As String

str = "C:\Program Files\Mozilla Thunderbird\Thunderbird"
str = str & " -compose " & Chr(34) & "mailto:" & strTo & "?"
str = str & "subject=" & Chr(34) & strSubject & Chr(34) & "&"
str = str & "body=" & Chr(34) & strBody & Chr(34)
Call Shell(str, vbNormalFocus)

End Function

'--------->>
Public Function rng2text(Rng As Range) As String
Dim arr As Variant
Dim lngRows As Long
Dim intCols As Integer
Dim rowCount As Long
Dim colCount As Integer
Dim colSize As Variant
Dim strLen As Long

arr = Rng
lngRows = UBound(arr, 1)
intCols = UBound(arr, 2)
ReDim colSize(intCols)
For rowCount = 1 To lngRows
For colCount = 1 To intCols
If Len(arr(rowCount, colCount)) + 5 > colSize(colCount) Then
colSize(colCount) = Len(arr(rowCount, colCount)) + 5
End If
Next ColCount
Next RowCount

For rowCount = 1 To lngRows
For colCount = 1 To intCols
strLen = colSize(colCount) - Len(arr(rowCount, colCount))
rng2text = rng2text & arr(rowCount, colCount) _
& String(strLen, Chr(160))
Next
rng2text = rng2text & "%0D%0A"
Next rowCount

End Function
'<<=========




===
Regards,
Norman
Marco Augusto
2017-08-25 11:28:22 UTC
Permalink
Post by Norman Jones
Ciao Marco,
Post by Marco Augusto
Salve a tutti
ho questa semplice macro per inviare email con thunderbird da un foglio excel
Se il Range del testo email è una cella va tutto bene (esempio "A3")
Viceversa se il Range è come da esempio "A3:C16" da errore
Qualcuno sa e può aiutarmi ?
Grazie in anticipo per la collaborazione
Sub sendmail()
Dim BodyMsg As String, Indirizzo As String, Oggetto As String
BodyMsg = Range("A3:C16").Value
Indirizzo = Range("A1").Value
Oggetto = Range("A2").Value
Shell "C:\Program Files (x86)\Mozilla Thunderbird\thunderbird -compose " _
& Chr$(34) & "to='" & Indirizzo & "',subject='" & Oggetto & "',body='" & BodyMsg _
& Chr$(34), vbNormalFocus
Application.Wait Now + TimeValue("00:00:03")
SendKeys "^{ENTER}"
End Sub
www.experts-exchange.com/questions/26517936/vba-to-send-excel-range-by-email-through-thunderbird.html
'=========>>
Option Explicit
'--------->>
Public Sub tbSendMaster()
Dim WB As Workbook
Dim SH As Worksheet
Dim RngBodyMsg As Range, RngIndirizzo As Range
Dim RngOggetto As Range
Dim sIndirizzo As String, sOggetto As String
Const sFoglio As String = "Foglio1"
Const sIntervalloBodyMsg As String = "A3:C16"
Const sIntervalloIndirizzo As String = "A1"
Const sIntervalloOggetto As String = "A2"
Const sIntestazioneBody As String = "Vede il seguenti dati"
Set WB = ThisWorkbook
Set SH = WB.Sheets(sFoglio)
With SH
Set RngBodyMsg = .Range(sBodyMsg)
Set RngIndirizzo = .Range(sIndirizzo)
Set RngOggetto = .Range(sOggetto)
End With
sIndirizzo = RngIndirizzo.Value
sOggetto = RngOggetto.Value
TB_MailSend sIndirizzo, sOggetto, sIntestazioneBody _
& "%0D%0A" & "%0D%0A" _
& rng2text(RngBodyMsg) _
& "%0D%0A" & "Endex"
End Sub
'--------->>
Public Function TB_MailSend(strTo As String, strSubject As String,
strBody As String)
Dim str As String
str = "C:\Program Files\Mozilla Thunderbird\Thunderbird"
str = str & " -compose " & Chr(34) & "mailto:" & strTo & "?"
str = str & "subject=" & Chr(34) & strSubject & Chr(34) & "&"
str = str & "body=" & Chr(34) & strBody & Chr(34)
Call Shell(str, vbNormalFocus)
End Function
'--------->>
Public Function rng2text(Rng As Range) As String
Dim arr As Variant
Dim lngRows As Long
Dim intCols As Integer
Dim rowCount As Long
Dim colCount As Integer
Dim colSize As Variant
Dim strLen As Long
arr = Rng
lngRows = UBound(arr, 1)
intCols = UBound(arr, 2)
ReDim colSize(intCols)
For rowCount = 1 To lngRows
For colCount = 1 To intCols
If Len(arr(rowCount, colCount)) + 5 > colSize(colCount) Then
colSize(colCount) = Len(arr(rowCount, colCount)) + 5
End If
Next ColCount
Next RowCount
For rowCount = 1 To lngRows
For colCount = 1 To intCols
strLen = colSize(colCount) - Len(arr(rowCount, colCount))
rng2text = rng2text & arr(rowCount, colCount) _
& String(strLen, Chr(160))
Next
rng2text = rng2text & "%0D%0A"
Next rowCount
End Function
'<<=========
===
Regards,
Norman
Ciao Marco,
Post by Marco Augusto
Salve a tutti
ho questa semplice macro per inviare email con thunderbird da un foglio excel
Se il Range del testo email è una cella va tutto bene (esempio "A3")
Viceversa se il Range è come da esempio "A3:C16" da errore
Qualcuno sa e può aiutarmi ?
Grazie in anticipo per la collaborazione
Sub sendmail()
Dim BodyMsg As String, Indirizzo As String, Oggetto As String
BodyMsg = Range("A3:C16").Value
Indirizzo = Range("A1").Value
Oggetto = Range("A2").Value
Shell "C:\Program Files (x86)\Mozilla Thunderbird\thunderbird -compose " _
& Chr$(34) & "to='" & Indirizzo & "',subject='" & Oggetto & "',body='" & BodyMsg _
& Chr$(34), vbNormalFocus
Application.Wait Now + TimeValue("00:00:03")
SendKeys "^{ENTER}"
End Sub
www.experts-exchange.com/questions/26517936/vba-to-send-excel-range-by-email-through-thunderbird.html
'=========>>
Option Explicit
'--------->>
Public Sub tbSendMaster()
Dim WB As Workbook
Dim SH As Worksheet
Dim RngBodyMsg As Range, RngIndirizzo As Range
Dim RngOggetto As Range
Dim sIndirizzo As String, sOggetto As String
Const sFoglio As String = "Foglio1"
Const sIntervalloBodyMsg As String = "A3:C16"
Const sIntervalloIndirizzo As String = "A1"
Const sIntervalloOggetto As String = "A2"
Const sIntestazioneBody As String = "Vede il seguenti dati"
Set WB = ThisWorkbook
Set SH = WB.Sheets(sFoglio)
With SH
Set RngBodyMsg = .Range(sBodyMsg)
Set RngIndirizzo = .Range(sIndirizzo)
Set RngOggetto = .Range(sOggetto)
End With
sIndirizzo = RngIndirizzo.Value
sOggetto = RngOggetto.Value
TB_MailSend sIndirizzo, sOggetto, sIntestazioneBody _
& "%0D%0A" & "%0D%0A" _
& rng2text(RngBodyMsg) _
& "%0D%0A" & "Endex"
End Sub
'--------->>
Public Function TB_MailSend(strTo As String, strSubject As String,
strBody As String)
Dim str As String
str = "C:\Program Files\Mozilla Thunderbird\Thunderbird"
str = str & " -compose " & Chr(34) & "mailto:" & strTo & "?"
str = str & "subject=" & Chr(34) & strSubject & Chr(34) & "&"
str = str & "body=" & Chr(34) & strBody & Chr(34)
Call Shell(str, vbNormalFocus)
End Function
'--------->>
Public Function rng2text(Rng As Range) As String
Dim arr As Variant
Dim lngRows As Long
Dim intCols As Integer
Dim rowCount As Long
Dim colCount As Integer
Dim colSize As Variant
Dim strLen As Long
arr = Rng
lngRows = UBound(arr, 1)
intCols = UBound(arr, 2)
ReDim colSize(intCols)
For rowCount = 1 To lngRows
For colCount = 1 To intCols
If Len(arr(rowCount, colCount)) + 5 > colSize(colCount) Then
colSize(colCount) = Len(arr(rowCount, colCount)) + 5
End If
Next ColCount
Next RowCount
For rowCount = 1 To lngRows
For colCount = 1 To intCols
strLen = colSize(colCount) - Len(arr(rowCount, colCount))
rng2text = rng2text & arr(rowCount, colCount) _
& String(strLen, Chr(160))
Next
rng2text = rng2text & "%0D%0A"
Next rowCount
End Function
'<<=========
===
Regards,
Norman
Grazie Norman per la pronta risposta; avevo già letto quel post e avevo provato ma non funzionava correttamente.
Ho provato anche la tua versione ho dichiarato la variabile che il debug dava non dichiarata sBodyMsg:
Dim sBodyMsg As String, sIndirizzo As String, sOggetto As String
ma ha dato poi errore al Range dell'SH:
Set RngBodyMsg = .Range(sBodyMsg)

hai qualche soluzione ?
Norman Jones
2017-08-25 12:01:28 UTC
Permalink
Ciao Marco.
Post by Marco Augusto
Grazie Norman per la pronta risposta; avevo già letto quel post e avevo provato ma non funzionava correttamente.
Dim sBodyMsg As String, sIndirizzo As String, sOggetto As String
Set RngBodyMsg = .Range(sBodyMsg)
Mea culpa, mea massima culpa!
Post by Marco Augusto
Post by Norman Jones
Set RngBodyMsg = .Range(sBodyMsg)
Set RngIndirizzo = .Range(sIndirizzo)
Set RngOggetto = .Range(sOggetto
Avrebbe dovuto essere:
Set RngBodyMsg = .Range(sIntervalloBodyMsg)
Set RngIndirizzo = .Range(sIntervalloIndirizzo)
Set RngOggetto = .Range(sIntervalloOggetto)

Io non avevo provato il codice perchè, per le email, utilizzo Outlook o
Gmail.
Post by Marco Augusto
hai qualche soluzione ?
Se non puoi utilizzare Outlook, che sarebbe ottimale, forse considera lo
sfuttamento di CDO (CDOSYS) che non richiede un programma email.





===
Regards,
Norman
Marco Augusto
2017-08-25 14:18:42 UTC
Permalink
Post by Norman Jones
Ciao Marco.
Post by Marco Augusto
Grazie Norman per la pronta risposta; avevo già letto quel post e avevo provato ma non funzionava correttamente.
Dim sBodyMsg As String, sIndirizzo As String, sOggetto As String
Set RngBodyMsg = .Range(sBodyMsg)
Mea culpa, mea massima culpa!
Post by Marco Augusto
Post by Norman Jones
Set RngBodyMsg = .Range(sBodyMsg)
Set RngIndirizzo = .Range(sIndirizzo)
Set RngOggetto = .Range(sOggetto
Set RngBodyMsg = .Range(sIntervalloBodyMsg)
Set RngIndirizzo = .Range(sIntervalloIndirizzo)
Set RngOggetto = .Range(sIntervalloOggetto)
Io non avevo provato il codice perchè, per le email, utilizzo Outlook o
Gmail.
Post by Marco Augusto
hai qualche soluzione ?
Se non puoi utilizzare Outlook, che sarebbe ottimale, forse considera lo
sfuttamento di CDO (CDOSYS) che non richiede un programma email.
===
Regards,
Norman
Ciao Marco.
Post by Marco Augusto
Grazie Norman per la pronta risposta; avevo già letto quel post e avevo provato ma non funzionava correttamente.
Dim sBodyMsg As String, sIndirizzo As String, sOggetto As String
Set RngBodyMsg = .Range(sBodyMsg)
Mea culpa, mea massima culpa!
Post by Marco Augusto
Post by Norman Jones
Set RngBodyMsg = .Range(sBodyMsg)
Set RngIndirizzo = .Range(sIndirizzo)
Set RngOggetto = .Range(sOggetto
Set RngBodyMsg = .Range(sIntervalloBodyMsg)
Set RngIndirizzo = .Range(sIntervalloIndirizzo)
Set RngOggetto = .Range(sIntervalloOggetto)
Io non avevo provato il codice perchè, per le email, utilizzo Outlook o
Gmail.
Post by Marco Augusto
hai qualche soluzione ?
Se non puoi utilizzare Outlook, che sarebbe ottimale, forse considera lo
sfuttamento di CDO (CDOSYS) che non richiede un programma email.
===
Regards,
Norman
Hi Norman,
ci siamo quasi :D
ho letto bene ttutto Ron de Bruin e modificato la Macro che funziona perfattamente ... QUASI ...
Sub sendmail()
Dim strbody As String, Indirizzo As String, Oggetto As String
Dim cell As Range

For Each cell In Sheets("Foglio1").Range("a3:C16")
strbody = strbody & cell.Value & vbNewLine
Next

Indirizzo = Range("A1").Value
Oggetto = Range("A2").Value
Shell "C:\Program Files (x86)\Mozilla Thunderbird\thunderbird -compose " _
& Chr$(34) & "to='" & Indirizzo & "',subject='" & Oggetto & "',body='" & strbody _
& Chr$(34), vbNormalFocus
Application.Wait Now + TimeValue("00:00:03")
SendKeys "^{ENTER}"
End Sub

....
il testo dell'email preso nelle celle indicate non è correttamente inviato come da file excel dove è formato in tabella ma viene inviato e quindi ricevuto come testo in colonna ...
Praticamente il valore di ogni cella nel range, è inviato uno sotto l'altro ...
soluzioni ?
Norman Jones
2017-08-25 15:10:53 UTC
Permalink
Ciao Marco,
Post by Marco Augusto
il testo dell'email preso nelle celle indicate non è correttamente inviato come da file excel dove è formato in tabella ma viene inviato e quindi ricevuto come testo in colonna ...
Praticamente il valore di ogni cella nel range, è inviato uno sotto l'altro ...
soluzioni ?
Ritorna al buon Ron de Bruin, e vedi la sezione entitolata *HTML text*
al fondo della pagine:
https://www.rondebruin.nl/win/s1/cdo.htm





===
Regards,
Norman
Marco Augusto
2017-08-29 09:21:54 UTC
Permalink
Post by Norman Jones
Ciao Marco,
Post by Marco Augusto
il testo dell'email preso nelle celle indicate non è correttamente inviato come da file excel dove è formato in tabella ma viene inviato e quindi ricevuto come testo in colonna ...
Praticamente il valore di ogni cella nel range, è inviato uno sotto l'altro ...
soluzioni ?
Ritorna al buon Ron de Bruin, e vedi la sezione entitolata *HTML text*
https://www.rondebruin.nl/win/s1/cdo.htm
===
Regards,
Norman
Ciao Marco,
Post by Marco Augusto
il testo dell'email preso nelle celle indicate non è correttamente inviato come da file excel dove è formato in tabella ma viene inviato e quindi ricevuto come testo in colonna ...
Praticamente il valore di ogni cella nel range, è inviato uno sotto l'altro ...
soluzioni ?
Ritorna al buon Ron de Bruin, e vedi la sezione entitolata *HTML text*
https://www.rondebruin.nl/win/s1/cdo.htm
===
Regards,
Norman
Ciao Norman,
macro funziona perfettamente:

Sub INVIAMAIL()
ultimariga = Cells(Rows.Count, "i").End(xlUp).Row
ActiveSheet.Range("i" & ultimariga, "ae" & ultimariga).Copy
Sheets("INVIAMAIL").Select
Range("A4").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Dim strbody As String, Indirizzo As String, Oggetto As String
Dim cell As Range
For Each cell In Sheets("INVIAMAIL").Range("a6:P6")
strbody = strbody & cell.Value & vbNewLine
Next
Indirizzo = Range("A7").Value
Oggetto = Range("A8").Value
Shell "C:\Program Files (x86)\Mozilla Thunderbird\thunderbird -compose " _
& Chr$(34) & "to='" & Indirizzo & "',subject='" & Oggetto & "',body='" & strbody & Chr$(34), vbNormalFocus
Application.Wait Now + TimeValue("00:00:03")
SendKeys "^{ENTER}"
Sheets("BASE").Select
Range("I1").Select
' va in ultima cella piena
Selection.End(xlDown).Select
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = "ito"
ActiveCell.Interior.ColorIndex = 6
End Sub

Ora, il testo che mando come semplice testo vorrei inviarlo come immagine creata da EXCEL; qui la macro che crea l'immagine che a me interessa:

Sub Macro3()
'
' Macro3 Macro

Range("C25:E38").Select
Selection.Copy
Range("H6:J19").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Selection.Copy
Range("H25").Select
ActiveSheet.Pictures.Paste.Select
ActiveSheet.Shapes.Range(Array("Picture 24")).Select
Range("G23").Select
ActiveSheet.Shapes.Range(Array("Picture 24")).Select
Selection.ShapeRange.Shadow.Type = msoShadow34
With Selection.ShapeRange.Line
.Visible = msoTrue
.ForeColor.RGB = RGB(0, 112, 192)
.Transparency = 0
End With
With Selection.ShapeRange.Line
.Visible = msoTrue
.Weight = 2.25
End With
Range("L22").Select
ActiveSheet.Shapes.Range(Array("Picture 24")).Select
Application.CutCopyMode = False
Selection.Copy

End Sub


Questa immagine così creata la copio nel corpo dell'email e la invio senza problemi. Non conosco però i comandi per trasformare l'immagine selezionata e copiata in un oggetto inviabile come body o htmlbody
O forse è più semplice in qualche altro modo che non conosco ...
Idee ?

Loading...