Cod VBA trimitere email-uri
Cod VBA trimitere email-uri
Salut,
Pentru a trimite email-uri automate din excel catre persoane diferete si atasament ediferete, am copiat de pe net (vedeti sursa in cod) codul VBA de mai jos. Doar ca acest cod nu imi adauga semnatura din email si nici nu imi ordoneaza textul unul sub altul, de exemplu daca vreau sa scriu mai multe fraze. Momentan textul apare asa:
"Hello,
Please find attached invoice for month December. Thank you. "
Ma puteti ajuta cu completarea codului VBA astfel incat sa apara de felul de mai jos, plus semnatura din email. Multumesc!
"Hello,
Please find attached invoice for month November 2018.
Thank you,"
Codul VBA:
Sub Send_Files()
'Working in Excel 2000-2016
'For Tips see: http://www.rondebruin.nl/win/winmail/Outlook/tips.htm
Dim OutApp As Object
Dim OutMail As Object
Dim sh As Worksheet
Dim cell As Range
Dim FileCell As Range
Dim rng As Range
With Application
.EnableEvents = False
.ScreenUpdating = False
End With
Set sh = Sheets("Sheet1")
Set OutApp = CreateObject("Outlook.Application")
For Each cell In sh.Columns("B").Cells.SpecialCells(xlCellTypeConstants)
'Enter the path/file names in the C:Z column in each row
Set rng = sh.Cells(cell.Row, 1).Range("C1:Z1")
If cell.Value Like "?*@?*.?*" And _
Application.WorksheetFunction.CountA(rng) > 0 Then
Set OutMail = OutApp.CreateItem(0)
With OutMail
.to = cell.Value
.Subject = "Invoice"
.Body = "Hello," _
& vbNewLine & vbNewLine & _
"Please find attached invoice for month November. " & _
"Thank you."
For Each FileCell In rng.SpecialCells(xlCellTypeConstants)
If Trim(FileCell) <> "" Then
If Dir(FileCell.Value) <> "" Then
.Attachments.Add FileCell.Value
End If
End If
Next FileCell
.Send 'Or use .Display
End With
Set OutMail = Nothing
End If
Next cell
Set OutApp = Nothing
With Application
.EnableEvents = True
.ScreenUpdating = True
End With
End Sub
Pentru a trimite email-uri automate din excel catre persoane diferete si atasament ediferete, am copiat de pe net (vedeti sursa in cod) codul VBA de mai jos. Doar ca acest cod nu imi adauga semnatura din email si nici nu imi ordoneaza textul unul sub altul, de exemplu daca vreau sa scriu mai multe fraze. Momentan textul apare asa:
"Hello,
Please find attached invoice for month December. Thank you. "
Ma puteti ajuta cu completarea codului VBA astfel incat sa apara de felul de mai jos, plus semnatura din email. Multumesc!
"Hello,
Please find attached invoice for month November 2018.
Thank you,"
Codul VBA:
Sub Send_Files()
'Working in Excel 2000-2016
'For Tips see: http://www.rondebruin.nl/win/winmail/Outlook/tips.htm
Dim OutApp As Object
Dim OutMail As Object
Dim sh As Worksheet
Dim cell As Range
Dim FileCell As Range
Dim rng As Range
With Application
.EnableEvents = False
.ScreenUpdating = False
End With
Set sh = Sheets("Sheet1")
Set OutApp = CreateObject("Outlook.Application")
For Each cell In sh.Columns("B").Cells.SpecialCells(xlCellTypeConstants)
'Enter the path/file names in the C:Z column in each row
Set rng = sh.Cells(cell.Row, 1).Range("C1:Z1")
If cell.Value Like "?*@?*.?*" And _
Application.WorksheetFunction.CountA(rng) > 0 Then
Set OutMail = OutApp.CreateItem(0)
With OutMail
.to = cell.Value
.Subject = "Invoice"
.Body = "Hello," _
& vbNewLine & vbNewLine & _
"Please find attached invoice for month November. " & _
"Thank you."
For Each FileCell In rng.SpecialCells(xlCellTypeConstants)
If Trim(FileCell) <> "" Then
If Dir(FileCell.Value) <> "" Then
.Attachments.Add FileCell.Value
End If
End If
Next FileCell
.Send 'Or use .Display
End With
Set OutMail = Nothing
End If
Next cell
Set OutApp = Nothing
With Application
.EnableEvents = True
.ScreenUpdating = True
End With
End Sub
-
- Mesaje: 433
- Membru din: Mar Dec 11, 2018 8:54 pm
Re: Cod VBA trimitere email-uri
Salut,
in loc de .body poti folosi .htmlbody
dim kMesaj as string
kMesaj = "Hello,"& "<br>" & _
"Please find attached invoice for month November. " ,"& "<br>" & _
"<br><br><B>Thank you</B>"
With OutMail
.to = cell.Value
.Subject = "Invoice"
.htmlbody = kMesaj
........
........
in loc de .body poti folosi .htmlbody
dim kMesaj as string
kMesaj = "Hello,"& "<br>" & _
"Please find attached invoice for month November. " ,"& "<br>" & _
"<br><br><B>Thank you</B>"
With OutMail
.to = cell.Value
.Subject = "Invoice"
.htmlbody = kMesaj
........
........
藍
"I fear the day that technology will surpass our human interaction. The world will have a generation of idiots."
Albert Einstein
"I fear the day that technology will surpass our human interaction. The world will have a generation of idiots."
Albert Einstein
Re: Cod VBA trimitere email-uri
Salut,
Am adugat codul mentionat si apare eroarea de mai jos, vezi atasat:
Compile error
Syntax error
Ce trebuie sa mai fac?
Multumesc,
Am adugat codul mentionat si apare eroarea de mai jos, vezi atasat:
Compile error
Syntax error
Ce trebuie sa mai fac?
Multumesc,
Nu aveţi permisiunea de a vizualiza fişierele ataşate acestui mesaj.
-
- Mesaje: 433
- Membru din: Mar Dec 11, 2018 8:54 pm
Re: Cod VBA trimitere email-uri
Ataseaza fisierul.
Pune aceasta parte dupa:
Set OutMail = OutApp.CreateItem(0)
dim kMesaj as string
kMesaj = "Hello,"& "<br>" & _
"Please find attached invoice for month November. " & "<br>" & _
"<br><br><B>Thank you</B>"
si evident inlocuieste partea cu With OutMail din codul tau cu:
With OutMail
.to = cell.Value
.Subject = "Invoice"
.htmlbody = kMesaj
Pune aceasta parte dupa:
Set OutMail = OutApp.CreateItem(0)
dim kMesaj as string
kMesaj = "Hello,"& "<br>" & _
"Please find attached invoice for month November. " & "<br>" & _
"<br><br><B>Thank you</B>"
si evident inlocuieste partea cu With OutMail din codul tau cu:
With OutMail
.to = cell.Value
.Subject = "Invoice"
.htmlbody = kMesaj
藍
"I fear the day that technology will surpass our human interaction. The world will have a generation of idiots."
Albert Einstein
"I fear the day that technology will surpass our human interaction. The world will have a generation of idiots."
Albert Einstein
Re: Cod VBA trimitere email-uri
Salut,
Acum merge, multumesc!
Crezi ca ma poti ajuta cumva ca sa apara si semnatura in email-urile care se trimit.
Multumesc,
Acum merge, multumesc!
Crezi ca ma poti ajuta cumva ca sa apara si semnatura in email-urile care se trimit.
Multumesc,
-
- Mesaje: 433
- Membru din: Mar Dec 11, 2018 8:54 pm
Re: Cod VBA trimitere email-uri
Semnatura este un fisier .jpg?
Daca da, atunci pune si urmat. linii de cod..
With OutMail
.to = cell.Value
.Subject = "Invoice"
.BodyFormat = 2
.htmlbody = kMesaj
.Attachments.Add ("calea catre fisierul cu semnatura - inclusiv fisierul ")
.....
.....
Daca da, atunci pune si urmat. linii de cod..
With OutMail
.to = cell.Value
.Subject = "Invoice"
.BodyFormat = 2
.htmlbody = kMesaj
.Attachments.Add ("calea catre fisierul cu semnatura - inclusiv fisierul ")
.....
.....
藍
"I fear the day that technology will surpass our human interaction. The world will have a generation of idiots."
Albert Einstein
"I fear the day that technology will surpass our human interaction. The world will have a generation of idiots."
Albert Einstein
Re: Cod VBA trimitere email-uri
Scuze ca nu am fost foarte clar dar am nevoie ca semnatura sa fie in textul email-ului si nu in atasament. Multumesc!
-
- Mesaje: 433
- Membru din: Mar Dec 11, 2018 8:54 pm
Re: Cod VBA trimitere email-uri
Păi de unde sa ia excelul semnătura?
Este undeva intro celula Excel? dacă da, care?
Este vorba de semnătura din Outlook?
Pe viitor dă toate detaliile....
Ca sa poți fi ajutat și să evitam sa tot punem întrebări...
Este undeva intro celula Excel? dacă da, care?
Este vorba de semnătura din Outlook?
Pe viitor dă toate detaliile....
Ca sa poți fi ajutat și să evitam sa tot punem întrebări...
藍
"I fear the day that technology will surpass our human interaction. The world will have a generation of idiots."
Albert Einstein
"I fear the day that technology will surpass our human interaction. The world will have a generation of idiots."
Albert Einstein
Re: Cod VBA trimitere email-uri
As prefera sa fie luata semnatura din Outlook.
Deasemenease este ok si varianta cu preluarea dintr-o celula (Sheet1, D1).
Deasemenease este ok si varianta cu preluarea dintr-o celula (Sheet1, D1).