Úprava kódu

Programy pro práci v kanceláři (Word, Excel, Access…=>Office)

Moderátor: Mods_senior

barunkabro
nováček
Příspěvky: 1
Registrován: červen 19
Pohlaví: Žena

Úprava kódu

Příspěvekod barunkabro » 12 čer 2019 09:18

Ahoj,

potřebovala bych poradit s tímto kódem na automatické vytvoření e-mailu v Excelu. Jelikož jsem úplný začátečník, potřebovala bych poradit, jak POD tu tabulku která se mi do mailu automaticky zkopíruje přidám další text. Je to možné?

Moc děkuji

Private Sub CommandButton3_Click()
Dim outlook As Object
Dim newEmail As Object
Dim xInspect As Object
Dim pageEditor As Object

Set outlook = CreateObject("Outlook.Application")
Set newEmail = outlook.CreateItem(0)

With newEmail
.To = Sheet4.Range("H1")
.CC = ""
.BCC = ""
.Subject = Sheet4.Range("D13")
.Body = Sheet4.Range("P23")
.display

Set xInspect = newEmail.GetInspector
Set pageEditor = xInspect.WordEditor

Sheet4.Range("B14:I15").Copy

pageEditor.Application.Selection.Start = Len(.Body)
pageEditor.Application.Selection.End = pageEditor.Application.Selection.Start
pageEditor.Application.Selection.PasteAndFormat (wdFormatPlainText)

.display
Set pageEditor = Nothing
Set xInspect = Nothing
End With

Set newEmail = Nothing
Set outlook = Nothing
End Sub



Reklama
Uživatelský avatar
Grimm
Level 1
Level 1
Příspěvky: 66
Registrován: září 17
Pohlaví: Muž

Re: Úprava kódu

Příspěvekod Grimm » 15 čer 2019 16:28

Ahoj, napadlo mě toto řešení. Zpráva v těle mailu bude rozdělena na dvě části, které se vloží současně a mezi ně se poté vloží zkopírovaná "tabulka".

Kód: Vybrat vše


Private Sub CommandButton3_Click()
Dim outlook As Object
Dim newEmail As Object
Dim xInspect As Object
Dim pageEditor As Object
Dim TextNadTabulkou As String
Dim TextPodTabulkou As String

Set outlook = CreateObject("Outlook.Application")
Set newEmail = outlook.CreateItem(0)

TextNadTabulkou = Sheet4.Range("P23")
TextPodTabulkou = Sheet4.Range("P24")

With newEmail
    .To = Sheet4.Range("H1")
    .CC = ""
    .BCC = ""
    .Subject = Sheet4.Range("D13")
    .body = TextNadTabulkou & vbNewLine & TextPodTabulkou
    .display
   
    Set xInspect = newEmail.GetInspector
    Set pageEditor = xInspect.WordEditor
   
    Sheet4.Range("B14:I15").Copy
   
    With pageEditor.Application.Selection
        .Start = Len(TextNadTabulkou)
        .End = pageEditor.Application.Selection.Start
        .PasteAndFormat (wdFormatPlainText)
    End With
    Application.CutCopyMode = False
    .display
End With

Set pageEditor = Nothing
Set xInspect = Nothing
Set newEmail = Nothing
Set outlook = Nothing
End Sub



  • Mohlo by vás zajímat
    Odpovědi
    Zobrazení
    Poslední příspěvek
  • Úprava kódu
    od luko02420 » 04 dub 2019 11:33 » v Kancelářské balíky
    4
    438
    od luko02420
    04 dub 2019 15:31
  • Úprava kódu pro odeslání emailu.
    od luko02420 » 01 zář 2018 20:10 » v Kancelářské balíky
    6
    790
    od luko02420
    04 zář 2018 20:14
  • Úprava kodu pro odeslání pdf.
    od luko02420 » 05 zář 2018 07:48 » v Kancelářské balíky
    6
    587
    od luko02420
    05 zář 2018 11:01
  • Oprava kódu chyby 0xc0000020
    od DeXx™ » 16 lis 2018 15:35 » v Windows 10, 8, 7, Vista, XP…
    6
    639
    od DeXx™
    20 lis 2018 17:17
  • úprava tabulky
    od butes » 15 led 2019 18:31 » v Kancelářské balíky
    5
    664
    od butes
    21 led 2019 09:41

Zpět na “Kancelářské balíky”

Kdo je online

Uživatelé prohlížející si toto fórum: CommonCrawl [Bot] a 5 hostů