VBA - excelből automatikus email, hivatkozással
2021-05-19T13:27:29+02:00
2021-05-25T09:07:35+02:00
2022-08-12T02:55:29+02:00
Nerich
Sziasztok!

Excel-ből szeretnék egy emailt generálni ahol az ott lévő adatokat tegye bele egy táblába, és ez legyen a szöveg rész (ez megy is), de vannak olyan oszlopok ahol hivatkozások vannak, és ezt nem tudom külön megadni, mindegyikre ráhúzza a hivatkozást.



Sub email2() Dim outlookApp As outlook.Application Dim myMail As outlook.MailItem Dim email As String email = Cells(2, 8) Dim rng As Range, cell As Range, HtmlContent As String, i As Long, j As Long, k As Long, l As Long Set rng = Range("A1:G15") HtmlContent = "<table border='2'>" For i = 1 To rng.Rows.Count HtmlContent = HtmlContent & "<tr>" For j = 1 To rng.Columns.Count HtmlContent = HtmlContent & "<td>" & "<a href='" & Cells(i, 9).Value & "'>" & Cells(i, j).Value & "</a></td>" Next HtmlContent = HtmlContent & "</tr>" Next HtmlContent = HtmlContent & "</table>" Set rng = Nothing Set rng = ActiveSheet.UsedRange Set outlookApp = New outlook.Application Set myMail = outlookApp.CreateItem(olMailItem) myMail.To = email myMail.Subject = "Teszt" With OutMail myMail.HTMLBody = HtmlContent End With myMail.Display True End Sub


Segítségeteket előre is köszönöm szépen!
Mutasd a teljes hozzászólást!
Szia!
Az a probléma, hogy külön ciklusban teszed be a hivatkozásokat és utána másik ciklusban a tábla többi elemét. Így az új ciklus új sorokat kezd a táblában.
Próbáld ki így a makrót:

Sub email() Dim outlookApp As outlook.Application Dim myMail As outlook.MailItem Dim email As String email = Cells(2, 8) Dim rng As Range, rng2 As Range, rng3 As Range, cell As Range, HtmlContent As String, i As Long, k As Long, l As Long, m As Long Set rng = Range("A1:A4") Set rng2 = Range("B1:G4") Set rng3 = Range("A1:G1") HtmlContent = "<table border='2'>" HtmlContent = HtmlContent & "<tr>" For m = 1 To 7 HtmlContent = HtmlContent & "<th>" & Cells(1, m).Value & "</th>" Next HtmlContent = HtmlContent & "</tr>" For i = 2 To rng.Rows.Count HtmlContent = HtmlContent & "<tr>" HtmlContent = HtmlContent & "<td>" & "<a href='" & Cells(i, 9).Value & "'>" & Cells(i, 1).Value & "</a></td>" 'Next 'For k = 2 To rng2.Rows.Count 'HtmlContent = HtmlContent & "<tr>" For l = 2 To 7 HtmlContent = HtmlContent & "<td>" & Cells(i, l).Value & "</td>" Next HtmlContent = HtmlContent & "</tr>" Next HtmlContent = HtmlContent & "</table>" Set rng = Nothing Set rng = ActiveSheet.UsedRange Set rng2 = Nothing Set rng2 = ActiveSheet.UsedRange Set outlookApp = New outlook.Application Set myMail = outlookApp.CreateItem(olMailItem) myMail.To = email myMail.Subject = "Teszt" With OutMail myMail.HTMLBody = HtmlContent End With myMail.Display True End Sub
Benne hagytam azt a 3 sort, amit ki kell hagyni, illetve a "második" ciklusban a sor változóját át kellett írni k helyett i.
Üdv.
Mutasd a teljes hozzászólást!

  • Ha a hivatkozás kell, akkor a
    cells(i,9).Hyperlinks(1).Address
    adatot használd inkább az "<a href"-ben
    Mutasd a teljes hozzászólást!
  • Hát tudom, lehet rosszul csináltam, de nem ment, most itt tartok:

    Sub email2() Dim outlookApp As outlook.Application Dim myMail As outlook.MailItem Dim email As String email = Cells(2, 8) Dim rng As Range, rng2 As Range, rng3 As Range, cell As Range, HtmlContent As String, i As Long, j As Long, k As Long, l As Long, m As Long Set rng = Range("A1:A4") Set rng2 = Range("B1:G4") Set rng3 = Range("A1:G1") HtmlContent = "<table border='2'>" HtmlContent = HtmlContent & "<tr>" For m = 1 To rng3.Columns.Count HtmlContent = HtmlContent & "<th>" & Cells(1, m).Value & "</th>" Next HtmlContent = HtmlContent & "</tr>" For i = 2 To rng.Rows.Count HtmlContent = HtmlContent & "<tr>" For j = 1 To rng.Columns.Count HtmlContent = HtmlContent & "<td>" & "<a href='" & Cells(i, 9).Value & "'>" & Cells(i, 1).Value & "</a></td>" Next For k = 2 To rng2.Rows.Count 'HtmlContent = HtmlContent & "<tr>" Next For l = 2 To rng2.Columns.Count + 1 HtmlContent = HtmlContent & "<td>" & Cells(k, l).Value & "</td>" Next HtmlContent = HtmlContent & "</tr>" Next MsgBox k & l 'HtmlContent = HtmlContent & "</tr>" HtmlContent = HtmlContent & "</table>" Set rng = Nothing Set rng = ActiveSheet.UsedRange Set rng2 = Nothing Set rng2 = ActiveSheet.UsedRange Set outlookApp = New outlook.Application Set myMail = outlookApp.CreateItem(olMailItem) myMail.To = email myMail.Subject = "Teszt" With OutMail myMail.HTMLBody = HtmlContent End With myMail.Display True End Sub




    Csak az oszlop2-7 be a Adat21,22,23, Adat31,32,33 stb. kéne lennie
    Mutasd a teljes hozzászólást!
    Csatolt állomány
  • Szia!
    Azt a ciklust, amiben a második számot teszed be, az első szám megadása utáni ciklusba kell bevinni.
    Üdv.
    Mutasd a teljes hozzászólást!
  • Nem ott van?

    Set rng = Range("A1:A4") Set rng2 = Range("B1:G4") Set rng3 = Range("A1:G1") HtmlContent = "<table border='2'>" HtmlContent = HtmlContent & "<tr>" For m = 1 To rng3.Columns.Count HtmlContent = HtmlContent & "<th>" & Cells(1, m).Value & "</th>" Next HtmlContent = HtmlContent & "</tr>" For i = 2 To rng.Rows.Count HtmlContent = HtmlContent & "<tr>" For j = 1 To rng.Columns.Count HtmlContent = HtmlContent & "<td>" & "<a href='" & Cells(i, 9).Value & "'>" & Cells(i, 1).Value & "</a></td>" Next For k = 2 To rng2.Rows.Count Next For l = 2 To rng2.Columns.Count + 1 HtmlContent = HtmlContent & "<td>" & Cells(k, l).Value & "</td>" Next HtmlContent = HtmlContent & "</tr>" Next HtmlContent = HtmlContent & "</table>"
    Mutasd a teljes hozzászólást!
  • Szia!
    Ha nem teszi bele az 1-2-3-at, hanem csak a 4-et akkor biztosan nem ott van, a 4 az a ciklus futása utáni változóérték lesz.
    Próbáld lépésenként futtatni és kiderül, hol van a bibi.
    Üdv.
    Mutasd a teljes hozzászólást!
  • A

    For j = 1 To rng.Columns.Count HtmlContent = HtmlContent & "<td>" & "<a href='" & Cells(i, 9).Value & "'>" & Cells(i, 1).Value & "</a></td>" Next

    esetén a "J"-nek mi a szerepe?
    Egymás után többször fogod ugyan azt kiírni.
    Mutasd a teljes hozzászólást!
  • Mivel végül rájöttem, hogy elég fix is így semmi :)
    Mutasd a teljes hozzászólást!
  • Minden felesleges ciklust kitöröltem, de nem akar működni :(

    Sub email() Dim outlookApp As outlook.Application Dim myMail As outlook.MailItem Dim email As String email = Cells(2, 8) Dim rng As Range, rng2 As Range, rng3 As Range, cell As Range, HtmlContent As String, i As Long, k As Long, l As Long, m As Long Set rng = Range("A1:A4") Set rng2 = Range("B1:G4") Set rng3 = Range("A1:G1") HtmlContent = "<table border='2'>" HtmlContent = HtmlContent & "<tr>" For m = 1 To 7 HtmlContent = HtmlContent & "<th>" & Cells(1, m).Value & "</th>" Next HtmlContent = HtmlContent & "</tr>" For i = 2 To rng.Rows.Count HtmlContent = HtmlContent & "<tr>" HtmlContent = HtmlContent & "<td>" & "<a href='" & Cells(i, 9).Value & "'>" & Cells(i, 1).Value & "</a></td>" Next For k = 2 To rng2.Rows.Count For l = 2 To 7 HtmlContent = HtmlContent & "<td>" & Cells(k, l).Value & "</td>" Next HtmlContent = HtmlContent & "</tr>" Next HtmlContent = HtmlContent & "</table>" Set rng = Nothing Set rng = ActiveSheet.UsedRange Set rng2 = Nothing Set rng2 = ActiveSheet.UsedRange Set outlookApp = New outlook.Application Set myMail = outlookApp.CreateItem(olMailItem) myMail.To = email myMail.Subject = "Teszt" With OutMail myMail.HTMLBody = HtmlContent End With myMail.Display True End Sub
    Mutasd a teljes hozzászólást!
    Csatolt állomány
  • Szia!
    Az a probléma, hogy külön ciklusban teszed be a hivatkozásokat és utána másik ciklusban a tábla többi elemét. Így az új ciklus új sorokat kezd a táblában.
    Próbáld ki így a makrót:

    Sub email() Dim outlookApp As outlook.Application Dim myMail As outlook.MailItem Dim email As String email = Cells(2, 8) Dim rng As Range, rng2 As Range, rng3 As Range, cell As Range, HtmlContent As String, i As Long, k As Long, l As Long, m As Long Set rng = Range("A1:A4") Set rng2 = Range("B1:G4") Set rng3 = Range("A1:G1") HtmlContent = "<table border='2'>" HtmlContent = HtmlContent & "<tr>" For m = 1 To 7 HtmlContent = HtmlContent & "<th>" & Cells(1, m).Value & "</th>" Next HtmlContent = HtmlContent & "</tr>" For i = 2 To rng.Rows.Count HtmlContent = HtmlContent & "<tr>" HtmlContent = HtmlContent & "<td>" & "<a href='" & Cells(i, 9).Value & "'>" & Cells(i, 1).Value & "</a></td>" 'Next 'For k = 2 To rng2.Rows.Count 'HtmlContent = HtmlContent & "<tr>" For l = 2 To 7 HtmlContent = HtmlContent & "<td>" & Cells(i, l).Value & "</td>" Next HtmlContent = HtmlContent & "</tr>" Next HtmlContent = HtmlContent & "</table>" Set rng = Nothing Set rng = ActiveSheet.UsedRange Set rng2 = Nothing Set rng2 = ActiveSheet.UsedRange Set outlookApp = New outlook.Application Set myMail = outlookApp.CreateItem(olMailItem) myMail.To = email myMail.Subject = "Teszt" With OutMail myMail.HTMLBody = HtmlContent End With myMail.Display True End Sub
    Benne hagytam azt a 3 sort, amit ki kell hagyni, illetve a "második" ciklusban a sor változóját át kellett írni k helyett i.
    Üdv.
    Mutasd a teljes hozzászólást!
  • Ouu már értem, köszönöm szépen!
    Mutasd a teljes hozzászólást!
Tetszett amit olvastál? Szeretnél a jövőben is értesülni a hasonló érdekességekről?
abcd