Mail

maryurs24
Mesaje: 70
Membru din: Joi Feb 21, 2013 8:34 am

Mail

Mesaj de maryurs24 » Dum Sep 22, 2019 5:57 pm

Salut
Am nevoie sa trimit un mail de 3ori pe zi, un tabel care poate diferi ca suprafata
Am scris urmatorul cod si merge , adica ma lasa sa selectez tabelul si creeaza mailul, dar nu reusesc sa lipesc automat tabelul selectat

Cod: Selectaţi tot

Sub Mail()

Dim OutApp As Object
Dim OutMail As Object
Dim tabel As Range
Set tabel = Application.InputBox("Selcteaza tabelul pt mail", Type:=8)
tabel.Copy

Set OutApp = CreateObject("outlook.application")
Set OutMail = OutApp.createitem(0)
On Error Resume Next

With OutMail
.To = "nicolae-marius.popa@daciagroup.com"
.CC = ""
.BCC = ""
.Subject = "Realizari"

.display 'sau .send pt trimitere

End With
'salvez si inchid fisierul


End Sub
Ma puteti ajuta?

Indigo-ONE
Mesaje: 433
Membru din: Mar Dec 11, 2018 8:54 pm

Re: Mail

Mesaj de Indigo-ONE » Dum Sep 22, 2019 9:07 pm

Am scris urmatorul cod si merge , adica ma lasa sa selectez tabelul si creeaza mailul, dar nu reusesc sa lipesc automat tabelul selectat
Pai daca ai scris codul, atunci ai omis sa pui datele copiate in Outlook.
Codul copiaza datele din acel tabel si atat. Mai trebuie sa pui si acele date in Outlook.

Mai trebuie doar o linie de cod. :lol:


"I fear the day that technology will surpass our human interaction. The world will have a generation of idiots."
Albert Einstein

maryurs24
Mesaje: 70
Membru din: Joi Feb 21, 2013 8:34 am

Re: Mail

Mesaj de maryurs24 » Lun Sep 23, 2019 3:28 am

Da.imi mai trebuie o linie, care nu imi iese,adica ce am scris eu nu lipeste nimic.

Indigo-ONE
Mesaje: 433
Membru din: Mar Dec 11, 2018 8:54 pm

Re: Mail

Mesaj de Indigo-ONE » Lun Sep 23, 2019 7:47 pm

Banuiesc ca ai rezolvat pana acum.
Imi pare rau dar azi nu m-am putut loga, nu imi dau seama de ce, dar de cate ori am incercat (de pe telefon) sa ma logez, imi dadea un mesaj ca nu am credentiale...


"I fear the day that technology will surpass our human interaction. The world will have a generation of idiots."
Albert Einstein

maryurs24
Mesaje: 70
Membru din: Joi Feb 21, 2013 8:34 am

Re: Mail

Mesaj de maryurs24 » Lun Sep 23, 2019 9:31 pm

inca nu am rezolvat. tot ce am scris eu nu lipeste tabelul copiat

TudyBTH
Moderator
Moderator
Mesaje: 993
Membru din: Joi Feb 11, 2016 2:12 pm
Localitate: Cluj Napoca

Re: Mail

Mesaj de TudyBTH » Lun Sep 23, 2019 9:45 pm

Buna,

Personal, prefer CDO pentru a transmite email automat, exista cateva avantaje dupa parerea mea fata de utilizarea Outlook.
Vezi daca te ajuta modelul de aici.
Am invatat sa inotam in apa, ca pestii
Am invatat sa zburam in aer, ca pasarile
A ramas doar sa invatam sa traim pe Pamant, ca Oamenii.

maryurs24
Mesaje: 70
Membru din: Joi Feb 21, 2013 8:34 am

Re: Mail

Mesaj de maryurs24 » Lun Sep 23, 2019 9:49 pm

Aplicația implicita pt mail e outlook. Nu putem instala altceva

TudyBTH
Moderator
Moderator
Mesaje: 993
Membru din: Joi Feb 11, 2016 2:12 pm
Localitate: Cluj Napoca

Re: Mail

Mesaj de TudyBTH » Lun Sep 23, 2019 10:04 pm

Pai tocmai acesta este unul dintre avantajele pentru care eu prefer CDO, nu conteaza ce program de email folosesti, NU trebuie instalat nimic.
Nu conteaza ce versiune Office ai instalata. Poti atasa orice tip de fisier, nu primesti avertizari de securitate.
Am invatat sa inotam in apa, ca pestii
Am invatat sa zburam in aer, ca pasarile
A ramas doar sa invatam sa traim pe Pamant, ca Oamenii.

Catalin B.
Moderator
Moderator
Mesaje: 813
Membru din: Vin Sep 09, 2011 4:05 pm
Localitate: Iaşi

Re: Mail

Mesaj de Catalin B. » Mar Sep 24, 2019 6:04 am

Copy-Paste nu merge in email body.
Trebuie sa formatezi continutul in format html, un exemply de email body:

Cod: Selectaţi tot

Sig = OutMail.HTMLbody 'get the signature, we will insert it later, at the end of the new body message
        .Subject = "Receipt for Payment"
        
        .HTMLbody = "<IMG src='Logo.png'><br />" & RangetoHTML(Rng) _
          & "<br /><a href=" & Range("Policy").Offset(0, 5) & ">" & Range("Policy") & "</a><br />" _
          & "<br /><a href=" & Range("TermDates").Offset(0, 5) & ">" & Range("TermDates") & "</a><br />" _
          & "<br /><a href=" & Range("Parking").Offset(0, 5) & ">" & Range("Parking") & "</a><br /><br /><br />" _
          & "<IMG src='Logo.png' width=120 height=80>" & "<br /><br />" & _
            "<b><font size=""4"">" & Range("Sapphire") & "</font></b><br />" & _
            "<a href=" & Range("WebSite").Offset(0, 5) & ">" & Range("WebSite") & "</a><br />" & _
            "<a href=" & Replace(Range("Phone").Offset(0, 5), " ", "%20") & ">" & Range("Phone") & "</a><br />" & _
            "<a href=" & Range("_Mailto").Offset(0, 5) & ">" & Range("_Mailto") & "</a><br />" & Sig
Functia RangetoHTML preia un range din excel si il transforma in html, acceptat de outlook, o gasesti si pe net:

Cod: Selectaţi tot

Function RangetoHTML(Rng As Range)
    
    Dim fso As Object
    Dim ts As Object
    Dim TempFile As String
    Dim TempWB As Workbook
 
    TempFile = Environ$("temp") & "\" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"
 
    'Copy the range and create a new workbook to paste the data in
    Rng.Copy
    Set TempWB = Workbooks.Add(1)
    With TempWB.Sheets(1)
        .Cells(1).PasteSpecial Paste:=8
        .Cells(1).PasteSpecial xlPasteValues, , False, False
        .Cells(1).PasteSpecial xlPasteFormats, , False, False
        .Cells(1).PasteSpecial xlPasteColumnWidths, , False, False
        .Cells(1).Select
        Application.CutCopyMode = False
        On Error Resume Next
        .DrawingObjects.Visible = True
        .DrawingObjects.Delete
        On Error GoTo 0
    End With
 
    'Publish the sheet to a htm file
    With TempWB.PublishObjects.Add( _
         SourceType:=xlSourceRange, _
         Filename:=TempFile, _
         Sheet:=TempWB.Sheets(1).Name, _
         Source:=TempWB.Sheets(1).UsedRange.Address, _
         HtmlType:=xlHtmlStatic)
        .Publish (True)
    End With
 
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
    RangetoHTML = ts.readall
    ts.Close
    RangetoHTML = Replace(RangetoHTML, "align=center x:publishsource=", _
                          "align=left x:publishsource=")
 
    TempWB.Close savechanges:=False
 
    Kill TempFile
 
    Set ts = Nothing
    Set fso = Nothing
    Set TempWB = Nothing
End Function
O alta varianta este sa folosesti editorul de text utilizat de outlook, in care poti sa executi copy paste:

Cod: Selectaţi tot

Dim wordDoc As Word.Document
Set wordDoc = outMail.GetInspector.WordEditor
wordDoc.Range.PasteExcelTable LinkedToExcel:=False, WordFormatting:=False, RTF:=False
Daca e nevoie de adaugat si alte texte, trebuie utilizat cod specific Word pentru adaugare paragrafe suplimentare.
Probleme să fie, că soluţii se găsesc...

Indigo-ONE
Mesaje: 433
Membru din: Mar Dec 11, 2018 8:54 pm

Re: Mail

Mesaj de Indigo-ONE » Mar Sep 24, 2019 8:24 am

Desigur se pot imagina diverse moduri de a copia date din excel in Outlook.
Ron de Bruin a venit si cu solutii. Functia RangetoHTML este scrisa de el.

In codul pe care l-ai postat, pune inainte de End Sub si aceasta linie:

Cod: Selectaţi tot

SendKeys "^v", True
Acum vei putea copia date din Excel in Outlook fara sa mai recurgi la HTML.
Sper sa auzim daca e OK.


"I fear the day that technology will surpass our human interaction. The world will have a generation of idiots."
Albert Einstein

Scrie răspuns

Înapoi la “Visual Basic for Application (VBA) cu Excel - Intrebari tehnice”