Makro

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

Moderátor: Mods_senior

p.bublik
Level 2
Level 2
Příspěvky: 220
Registrován: únor 12
Bydliště: Jižní čechy
Pohlaví: Muž
Stav:
Offline

Makro

Příspěvekod p.bublik » 11 dub 2014 21:18

Ahoj,
chtěl bych poradit. Mám níže uvedené makro v sešitě. Které odesílá prostřednictví Outloku email na určitou adresu označená políčka. Jenže do samotného emailu swe nevloží podpis, který mam nastavený v Outlooku. Nevíte kde nebo jak toto nastavit? Předem písu že automaticky podpisy do nových emailů který vytvořím v Outlooku jsou vkládany.


Makro:
Sub odesli_test_test()

ActiveSheet.Range("C8:I34").Select

' Show the envelope on the ActiveWorkbook.
ActiveWorkbook.EnvelopeVisible = False


With ActiveSheet.MailEnvelope
.Item.To = "xy@xy.cz"
.Item.CC = ""
.Item.Subject = "test"
.Item.Send

End With

Range("E20:H30").Select
Selection.ClearContents

ActiveWorkbook.Save

End Sub

Reklama
Azuzula
Level 3
Level 3
Příspěvky: 452
Registrován: leden 12
Bydliště: Země, bohužel...
Pohlaví: Žena
Stav:
Offline
Kontakt:

Re: Makro

Příspěvekod Azuzula » 11 dub 2014 21:27

Ahoj, mrkni třeba sem: http://www.rondebruin.nl/win/s1/outlook/signature.htm

Nebo jednoduše můžeš podpis doplnit přímo do makra nebo do dalšího řádku v excelu ;)
Pokud je to vše.
Vše co znám z VBA jsem se naučila tady na fóru, na Office.lasakovi, david-zbiral.cz a hlavně hledáním na googlu.
SZ není poradna, na pokládání dotazů je tu fórum. Děkuji.

cmuch
Level 4.5
Level 4.5
Příspěvky: 1544
Registrován: březen 11
Bydliště: Drsná Vysočina :D
Pohlaví: Muž
Stav:
Offline

Re: Makro

Příspěvekod cmuch » 11 dub 2014 21:28

Nemám outlook, jen jsem něco našel.

Kód: Vybrat vše

Dim OutApp As Object
Dim OutMail As Object
Dim strbody As String

Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)

 strbody = "text emailu"

 On Error Resume Next
 With OutMail
 .Display
 .To = ""
 .Subject = "předmět"
 .HTMLBody = strbody & "<br>" & .HTMLBody
 .Display
 End With

 On Error GoTo 0

 Set OutMail = Nothing
 Set OutApp = Nothing

p.bublik
Level 2
Level 2
Příspěvky: 220
Registrován: únor 12
Bydliště: Jižní čechy
Pohlaví: Muž
Stav:
Offline

Re: Makro

Příspěvekod p.bublik » 11 dub 2014 21:36

Podpis doplnit do Makra nemohu, protože to bude využívat více lidí a každý má jiný podpis.

p.bublik
Level 2
Level 2
Příspěvky: 220
Registrován: únor 12
Bydliště: Jižní čechy
Pohlaví: Muž
Stav:
Offline

Re: Makro

Příspěvekod p.bublik » 12 dub 2014 10:49

Mám tady toto makro, ale prostě mail to odešle v textu je jen true a podpis, ale už to nevloží ty potřebné políčka do toho mailu jako předchízející moje verze, ale bez podpisu


Sub Mail_Outlook_With_Signature_Html_1()
Dim OutApp As Object
Dim OutMail As Object
Dim strbody As String

Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)

strbody = ActiveSheet.Range("D9:I33").Select
ActiveWorkbook.EnvelopeVisible = False
On Error Resume Next

With OutMail
.Display
.To = "xy@xy.xy"
.CC = ""
.Subject = "test"
.HTMLBody = strbody & "<br>" & .HTMLBody
.Send
End With

Range("E20:H29").Select
Selection.ClearContents
ActiveWorkbook.Save

On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
End Sub

Azuzula
Level 3
Level 3
Příspěvky: 452
Registrován: leden 12
Bydliště: Země, bohužel...
Pohlaví: Žena
Stav:
Offline
Kontakt:

Re: Makro

Příspěvekod Azuzula » 12 dub 2014 19:14

Podle mého je chyba v tom .select na konci viz code.Outlook nepoužívám, tak to nevyzkouším, ale smazala bych to .select a měly by se vkládat buňky do těla mailu.

Kód: Vybrat vše

strbody = ActiveSheet.Range("D9:I33").Select
Pokud je to vše.
Vše co znám z VBA jsem se naučila tady na fóru, na Office.lasakovi, david-zbiral.cz a hlavně hledáním na googlu.
SZ není poradna, na pokládání dotazů je tu fórum. Děkuji.

p.bublik
Level 2
Level 2
Příspěvky: 220
Registrován: únor 12
Bydliště: Jižní čechy
Pohlaví: Muž
Stav:
Offline

Re: Makro

Příspěvekod p.bublik » 13 dub 2014 19:22

Když odeberu .select tak to hodí chybu na řídku 13 a nic to neudělá.
Na řádku 13 je právě

strbody = ActiveSheet.Range("D9:I33")

Azuzula
Level 3
Level 3
Příspěvky: 452
Registrován: leden 12
Bydliště: Země, bohužel...
Pohlaví: Žena
Stav:
Offline
Kontakt:

Re: Makro

Příspěvekod Azuzula » 13 dub 2014 20:22

pardon, unikla mi ještě deklarace proměnné strbody
přepsat z Dim strbody as string na Dim strbody as Variant pak by to mohlo jít.
Pokud je to vše.
Vše co znám z VBA jsem se naučila tady na fóru, na Office.lasakovi, david-zbiral.cz a hlavně hledáním na googlu.
SZ není poradna, na pokládání dotazů je tu fórum. Děkuji.

p.bublik
Level 2
Level 2
Příspěvky: 220
Registrován: únor 12
Bydliště: Jižní čechy
Pohlaví: Muž
Stav:
Offline

Re: Makro

Příspěvekod p.bublik » 13 dub 2014 21:31

Bohužel ani to nejde, odešle se jen email s podpisem :(

Sub Mail_Outlook_With_Signature_Html_1()
Dim OutApp As Object
Dim OutMail As Object
Dim strbody As Variant

Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)

strbody = ActiveSheet.Range("D9:I33")
ActiveWorkbook.EnvelopeVisible = False
On Error Resume Next

With OutMail
.Display
.To = "xy@xy.yx"
.CC = ""
.Subject = "test"
.HTMLBody = strbody & "<br>" & .HTMLBody
.Send
End With

Range("E20:H29").Select
Selection.ClearContents
ActiveWorkbook.Save

On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
End Sub

Azuzula
Level 3
Level 3
Příspěvky: 452
Registrován: leden 12
Bydliště: Země, bohužel...
Pohlaví: Žena
Stav:
Offline
Kontakt:

Re: Makro

Příspěvekod Azuzula » 14 dub 2014 09:48

Aha, no... tak třeba takhle:

Kód: Vybrat vše

Sub Mail_Outlook_With_Signature_Html_1()
Dim OutApp As Object
Dim OutMail As Object
Dim strBody As String
Dim rngBody As Range
Dim rngBunka As Range

Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)

'zpracování těla e-mailu
Set rngBody = ActiveSheet.Range("D9:I33")

For Each rngBunka In rngOblast
    strBody = strBody &  rngBunka
Next

ActiveWorkbook.EnvelopeVisible = False
On Error Resume Next

With OutMail
.Display
.To = "xy@xy.yx"
.CC = ""
.Subject = "test"
.HTMLBody = strBody & "<br>" & .HTMLBody
.Send
End With

Range("E20:H29").Select
Selection.ClearContents
ActiveWorkbook.Save

On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
End Sub

Předpoklad je, že v buňkách s tělem e-mailu máš nějaký html kód a tím pádem nesejde na formátování buněk v excelu. Pokud potřebuješ formátování přenést do e-mailu tak jak je v excelu, tak to nejspíš budeme muset vyřešit jiným způsobem.
Pokud je to vše.
Vše co znám z VBA jsem se naučila tady na fóru, na Office.lasakovi, david-zbiral.cz a hlavně hledáním na googlu.
SZ není poradna, na pokládání dotazů je tu fórum. Děkuji.


  • Mohlo by vás zajímat
    Odpovědi
    Zobrazení
    Poslední příspěvek
  • Makro pro myš Rapture Python
    od mmmartin » 27 srp 2023 15:18 » v Problémy s hardwarem
    9
    1111
    od mmmartin Zobrazit poslední příspěvek
    29 srp 2023 16:47

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

Kdo je online

Uživatelé prohlížející si toto fórum: Žádní registrovaní uživatelé a 3 hosti