Note: The other languages of the website are Google-translated. Back to English

Kako samodejno spremeniti podpis glede na prejemnike v Outlooku?

Outlook ima privzeto vgrajeno funkcijo, ki uporabnikom omogoča samodejno spreminjanje podpisa med pošiljanjem e-pošte prek različnih e-poštnih računov. Toda poleg tega vam bom tukaj prikazal način samodejnega spreminjanja podpisa na podlagi različnih prejemnikov v polju Za v Outlooku.

Samodejno spremenite podpis na podlagi prejemnikov s kodo VBA


Samodejno spremenite podpis na podlagi prejemnikov s kodo VBA

Sledite spodnjim korakom, da med pošiljanjem e-pošte v Outlooku uporabite različne podpise za ustrezne prejemnike.

1. Najprej morate v Outlooku onemogočiti funkcijo samodejnega pripisa podpisa. Kliknite file > možnosti da odprete Outlook Možnosti okno.

2. V Ljubljani Outlook Možnosti okno, izberite mail v levem podoknu kliknite na Podpisi gumb v Sestavi sporočila odsek. Oglejte si posnetek zaslona:

3. V Ljubljani Podpisi in tiskovine pogovorno okno, pojdite na Izberite privzeti podpis oddelek pod E-poštni podpis izberite e-poštni račun v E-poštni račun spustnega seznama in nato izberite (Brez) Iz Nova sporočila in Odgovori / posredovanje spustnih seznamov. Ponavljajte te korake, dokler niso vsi e-poštni računi nastavljeni na (Brez). Nato kliknite na OK gumb.

Opombe: V tem lahko ustvarite tudi potrebne podpise Podpisi in tiskovine pogovorno okno.

4. Kliknite OK , ko vrne Outlook Možnosti okno.

5. Pritisnite druga + F11 tipke za odpiranje Microsoft Visual Basic za aplikacije okno.

6. V Ljubljani Microsoft Visual Basic za aplikacije okno, dvokliknite Ta OutlookSession v levem podoknu, da odprete okno Code, in kopijo pod kodo VBA v okno. Oglejte si posnetek zaslona:

Koda VBA: samodejno spremeni podpis glede na prejemnike v Outlooku

Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
'Updated by ExtendOffice 2022/08/01
Dim xMailItem As MailItem
Dim xRecipients As Recipients
Dim xRecipient As Recipient
Dim xRcpAddress As String
Dim xSignatureFile, xSignaturePath As String
Dim xFSO As Scripting.FileSystemObject
Dim xDoc As Document
Dim xFindStr As String
On Error Resume Next
Set xFSO = New Scripting.FileSystemObject
If Item.Class <> olMail Then Exit Sub
Set xMailItem = Item
Set xRecipients = xMailItem.Recipients
xSignaturePath = CreateObject("WScript.Shell").SpecialFolders(5) + "\Microsoft\Signatures\"
For Each xRecipient In xRecipients
    If xRecipient.AddressEntry.AddressEntryUserType = olExchangeUserAddressEntry Then
        xRcpAddress = xRecipient.AddressEntry.GetExchangeUser.PrimarySmtpAddress
    Else
        xRcpAddress = xRecipient.AddressEntry.Address
    End If
    Select Case xRcpAddress
        Case "Email Address 1"
            xSignatureFile = xSignaturePath & "aaa.htm"
            Exit For
        Case "Email Address 2", "Email Address 3"
            xSignatureFile = xSignaturePath & "bbb.htm"
            Exit For
        Case "Email Address 4"
            xSignatureFile = xSignaturePath & "ccc.htm"
            Exit For
    End Select
Next
VBA.DoEvents
Set xDoc = xMailItem.GetInspector.WordEditor
xFindStr = "From: " & xMailItem.Recipients.Item(1).Name & " <" & xRcpAddress & ">"
If VBA.InStr(1, xMailItem.Body, xFindStr) <> 0 Then
    xDoc.Application.Selection.HomeKey Unit:=wdStory, Extend:=wdMove
    With xDoc.Application.Selection.Find
        .ClearFormatting
        .Text = xFindStr
        .Execute Forward:=True
    End With
    With xDoc.Application.Selection
        .MoveLeft wdCharacter, 2
        .InsertParagraphAfter
        .MoveDown Unit:=wdLine, Count:=1
    End With
Else
    With xDoc.Application.Selection
        .EndKey Unit:=wdStory, Extend:=wdMove
        .InsertParagraphAfter
        .MoveDown Unit:=wdLine, Count:=1
    End With
End If
xDoc.Application.Selection.InsertFile FileName:=xSignatureFile, Link:=False, Attachment:=False
End Sub

Opombe:

  • 1). V kodi VBA zamenjajte »E-poštni naslov 1/2/3/4"Z določenimi e-poštnimi naslovi prejemnikov.
  • 2). "aaa.htm""bbb.htm"In"ccc.htm« so navedeni podpisi, ki jih boste poslali ustreznim prejemnikom.
  • 3). V tem primeru podpis „aaa”Bo poslano na“E-poštni naslov 1", Podpis"bbb”Bo poslano na“E-poštni naslov 2"In"E-poštni naslov 3", in "E-poštni naslov 4”Bo prejel e-poštno sporočilo, vdelano s podpisom“ccc". Prosimo, spremenite jih glede na vaše potrebe.
  • 4). Če je v e-poštnem sporočilu več prejemnikov, koda upošteva samo prvega prejemnika. V tem primeru bodo drugi prejemniki prejeli e-poštna sporočila z enakim podpisom kot prvi prejemnik.

7. Nato kliknite Orodja > Reference Pojdite na Reference-Projekt pogovorno okno. V pogovornem oknu preverite oba Knjižnica predmetov Microsoft Word in Izvajanje Microsoftovih skriptov in nato kliknite OK gumb, glej posnetek zaslona:

8. Pritisnite druga + Q tipke za zapiranje Microsoft Visual Basic za aplikacije okno.

Od zdaj naprej se bo po sestavi e-poštnega sporočila in pritisku na gumb Pošlji ustrezen podpis samodejno vstavil na konec e-poštnega telesa na podlagi e-poštnega naslova prejemnika v polju Za.


Samodejno vstavi trenutni datum kot podpis pri pošiljanju e-pošte v Outlooku:

Če želite vstaviti časovni žig kot podpis v telo e-pošte med ustvarjanjem / odgovarjanjem / posredovanjem novega e-poštnega sporočila v Outlooku, lahko omogočite Dodajte podpis datuma, ko ustvarite novo, odgovorite in posredujete e-pošto možnost Kutools za Outlook da bi ga dosegli. Oglejte si posnetek zaslona:
Prenesite in preizkusite zdaj (60-dnevna brezplačna pot)


Kutools za Outlook - prinaša 100 naprednih funkcij v Outlook in olajša delo!

  • Samodejno CC / BCC po pravilih pri pošiljanju e-pošte; Samodejno posredovanje naprej Več e-poštnih sporočil po meri; Samodejni odgovor brez strežnika za izmenjavo in več samodejnih funkcij ...
  • Opozorilo pred BCC - prikaži sporočilo, ko poskušate odgovoriti vsem če je vaš poštni naslov na seznamu BCC; Opomni, ko manjkajo priloge, in več opomnikov ...
  • Odgovori (vsi) z vsemi prilogami v e-poštnem pogovoru; Odgovori na veliko e-poštnih sporočil v nekaj sekundah; Samodejno dodaj pozdrav ko odgovor; Dodaj datum v zadevo ...
  • Orodja za priloge: Upravljanje vseh prilog v vseh e-poštnih sporočilih, Samodejno loči, Stisni vse, Preimenuj vse, Shrani vse ... Hitro poročilo, Štejte izbrano pošto...
  • Zmogljiva neželena e-poštna sporočila po meri; Odstranite podvojene pošte in stike... Omogočajo vam pametnejše, hitrejše in boljše delovanje v Outlooku.
strelec kutools outlook kutools zavihek 1180x121
shot kutools outlook kutools plus jeziček 1180x121
 
Komentarji (31)
Ocene še ni. Bodite prvi in ​​ocenite!
Ta komentar je moderator na spletnem mestu minimiziral
Kako bi se to obnašalo, če je prejemnikov več?
Ta komentar je moderator na spletnem mestu minimiziral
Živjo Devansh,
Če je v e-poštnem sporočilu več prejemnikov, koda deluje samo za prvega. Vsi prejemniki bodo prejeli e-poštno sporočilo z enakim podpisom, ki je določen za to osebo.
Če želite vključiti različne podpise, ko je več prejemnikov, je treba e-pošto poslati ločeno različnim prejemnikom. In za to bo potrebna druga koda.
Ta komentar je moderator na spletnem mestu minimiziral
Zdravo! Zelo lep skript, vendar obstaja težava pri pošiljanju na naslove excahnge, xRcpAddress vrne ime X400 in ne naslov smtp, zato je nemogoče izbrati glede na domeno. Ali obstaja rešitev za to?


Samo za izboljšanje sem stavek case spremenil v če uporabljam funkcijo inStr za zaznavanje pošte v velikem obsegu

Če InStr(xRcpAddress, "@example") Potem
xSignatureFile = xSignaturePath & "aaa.htm"
Konec Če
Ta komentar je moderator na spletnem mestu minimiziral
Ta pameten skript sem dodal v Outlook 2013 in pravilno identificira in izbere različne e-poštne podpise, ki jih uporabljam.

Imam težavo z eno od grafik, ki je del enega podpisa. Namesto da bi bila prikazana grafika, mapa »Poslani predmeti« (in prejemnik) prikazuje e-pošto s priloženim posnetkom zaslona in poskus prenosa slike ne deluje.

Če onemogočim skript in se ročno podpišem, je odhodna e-pošta pravilna in prejemnik dobi tisto, kar nameravam. Še bolj zanimivo je, da je z drugim preprostejšim podpisom, kjer je grafika le ravna črta, to vključeno, čeprav je grafika nekoliko spremenjena.

Grafika je datoteka PNG 80KB 5904 x 1024 slikovnih pik z bitno globino 32 in poskusil sem z manjšimi velikostmi do 10KB 369 x 64 slikovnih pik, kar ni pomagalo. Moja različica Outlooka je 15.0.5189.1000 32Bit Professional Plus 2013 na platformi Windows 10 Pro.

Zanima me, če lahko predlagate rešitev za to.
Ta komentar je moderator na spletnem mestu minimiziral
Draga Amanda,
Posodobili smo kodo. Hvala, ker ste me opozorili na napako.
Ta komentar je moderator na spletnem mestu minimiziral
Zelo lep skript, vendar slikovne datoteke v mojem podpisu niso pravilno dostavljene. Ali lahko odpravite to težavo?
Ta komentar je moderator na spletnem mestu minimiziral
Živjo Vysakh,
Koda je bila posodobljena in težava s slikami je zdaj odpravljena. Oprostite za nevšečnosti.
Ta komentar je moderator na spletnem mestu minimiziral
Živjo Crystal,

kaj ste spremenili, da bi odpravili težave s slikami? Uporabljam vašo najnovejšo kodo in imam enak problem kot Amanda.
Hvala
Ta komentar je moderator na spletnem mestu minimiziral
Hi,
Oprostite za napako. VBA je bil znova posodobljen in težava s slikami je zdaj popolnoma odpravljena.
Ta komentar je moderator na spletnem mestu minimiziral
Poleg kode se je spremenilo tudi delovanje 7. koraka. Prosimo, sledite navodilom korak za korakom, da ga spustite.
Ta komentar je moderator na spletnem mestu minimiziral
Živjo, to bi rad uporabil za razlikovanje podpisov pri pošiljanju notranjih in zunanjih e-poštnih sporočil. Zato bi moral namesto prepoznavanja določenih e-poštnih naslovov razlikovati samo po e-poštnem naslovu prejemnika, ki vsebuje ime mojega podjetja, ali ne. Ali mi lahko sporočite, kakšna bi bila koda za ta poseben primer?


(Na primer, če bi se želel podpisati s podpisom "internal.htm", ko e-poštni naslov prejemnika vsebuje niz "microsoft" in podpis "external.htm", če ne vsebuje niza "microsoft". V tem primeru naslovi, kot je ' jane@microsoft.com«, »tom@microsoft.support.com« in »recruiting@microsoft.europe.com« bi se vsi obravnavali kot interni prejemniki za zaposlenega pri Microsoftu).

Hvala !!
Ta komentar je moderator na spletnem mestu minimiziral
Živjo pauli,
Poskusite s spodnjo kodo. Preden uporabite kodo, pojdite na Reference pogovorno okno za preverjanje Knjižnica predmetov Microsoft Word polje (kot je prikazana priložena slika).

Private Sub Application_ItemSend (ByVal Element kot predmet, Prekliči kot Boolean)

'Posodobil ExtendOffice 2020 / 6 / 12

Zatemni xMailItem kot MailItem

Dim xRecipients kot prejemniki

Dim xRecipient kot prejemnik

Dim xRcpAddress kot niz

Dim xSignatureFile, xSignaturePath kot niz

Zatemni xFSO kot Scripting.FileSystemObject

Dim xDoc kot dokument

On Error Resume Next

Nastavite xFSO = New Scripting.FileSystemObject

Če Item.Class <> olMail Nato Exit Sub

Nastavite xMailItem = Predmet

Nastavite xRecipients = xMailItem.Recipients

xSignaturePath = CreateObject("WScript.Shell").SpecialFolders(5) + "\Microsoft\Signatures\"

Za vsakega xRecipient v xRecipients

Če je xRecipient.AddressEntry.AddressEntryUserType = olExchangeUserAddressEntry, potem

xRcpAddress = xRecipient.AddressEntry.GetExchangeUser.PrimarySmtpAddress

Else

xRcpAddress = xRecipient.AddressEntry.Address

Konec Če

Če VBA.InStr(VBA.LCase(xRcpAddress), "@microsoft") > 0 Nato 'Vnesite niz v dvojne narekovaje. Če e-poštni naslov prejemnika vsebuje ta niz, bo e-poštnemu sporočilu dodeljen spodnji podpis "internal.htm". V nasprotnem primeru dodelite podpis "external.htm".

xSignatureFile = xSignaturePath & "notranji.htm"

Izhod za

Else

xSignatureFile = xSignaturePath & "zunanja.htm"

Konec Če

Naslednji

VBA.DoEvents

Nastavite xDoc = xMailItem.GetInspector.WordEditor

xDoc.Application.Selection.EndKey

xDoc.Application.Selection.InsertParagraphAfter

xDoc.Application.Selection.MoveDown Enota:=wdLine, Število:=1

xDoc.Application.Selection.InsertFile FileName:=xSignatureFile, Link:=False, Attachment:=False

End Sub
Ta komentar je moderator na spletnem mestu minimiziral
Živjo, Crystal, imam vprašanje. Ko pošiljam e-poštna sporočila zunanjim in notranjim prejemnikom, kako jih lahko razlikujem tako, da izberem vedno zunanji podpis? Hvala
Ta komentar je moderator na spletnem mestu minimiziral
Morda ste že našli rešitev zase ali pa ste že zdavnaj opustili to temo, vendar čutim željo, da to končam zdaj. Preprost odgovor na to vprašanje:
Uredite klavzulo If-Else (ki razlikuje med obema podpisoma) na naslednje:
Če je VBA.InStr(VBA.LCase(xRcpAddress), "@microsoft") = 0, potem 'Vnesite niz v dvojne narekovaje. Če e-poštni naslov prejemnika vsebuje ta niz, bo e-poštnemu sporočilu dodeljen spodnji podpis "internal.htm". V nasprotnem primeru dodelite podpis "external.htm".
xSignatureFile = xSignaturePath & "external.htm"
Izhod za
Else
xSignatureFile = xSignaturePath & "internal.htm"
Konec Če

Kaj se zgodi zdaj:
Če naslov prejemnika s seznama naslovov prejemnikov NE vsebuje podanega niza, uporabite zunanji podpis in nehajte iskati nadaljnje prejemnike. V nasprotnem primeru uporabite notranji podpis in poiščite naslednji naslov prejemnika.
Ta komentar je moderator na spletnem mestu minimiziral
Imam nekaj čudnega obnašanja pri e-poštnih sporočilih Outlooka, ki jih ustvari VBA. Podpis je dodan e-poštnemu sporočilu, kot je bilo predvideno, vendar ne na dnu e-pošte, temveč na sredini (izgleda kot prvi prazen prostor). Imate kakšno idejo zakaj in kako to premagati?
Ta komentar je moderator na spletnem mestu minimiziral
Tim imam enak problem. Tam, kjer uporabnik nazadnje klikne, je slika vstavljena. Ali ima kdo način, da vsilim sliko tik nad podpisom?
Ta komentar je moderator na spletnem mestu minimiziral
Pozdravljeni Crystal,
Zanima me koda VBA, ki ste jo napisali za "pauli" spodaj, a ko jo zaženem, se ustvari naslednja napaka (in označena je kodna vrstica "XDoc kot dokument"):
"Napaka pri prevajanju: uporabniško definirana vrsta ni določena"
Kako lahko rešim to težavo, prosim?

Hvala, Tim
Ta komentar je moderator na spletnem mestu minimiziral
Pozdravljeni Crystal,

Zanima me koda VBA, ki ste jo napisali za "pauli" spodaj, a ko jo zaženem, se ustvari naslednja napaka (in označena je kodna vrstica "XDoc kot dokument"):

"Napaka pri prevajanju: uporabniško definirana vrsta ni določena"

Kako lahko rešim to težavo, prosim?

Hvala!
Ta komentar je moderator na spletnem mestu minimiziral
Živjo Tim, Preden uporabite kodo, pojdite v pogovorno okno Reference in preverite Knjižnica predmetov Microsoft Word polje (kot je prikazana priložena slika).
Ta komentar je moderator na spletnem mestu minimiziral
Odličen scenarij. Hvala. Na kakršen koli način vstavite podpis, preden pritisnete pošlji v predogled. Vem, da lahko odložim pošiljanje in si ga ogledam v mapi za pošiljanje. Trenutno se ne prikaže, dokler ne pritisnem send. Če ne, obstaja programska oprema, ki bo samodejno dodelila podpis na podlagi stika. Že vrsto let uporabljamo program, ki je deloval odlično, vendar ne deluje v novih različicah Outlooka.
Ta komentar je moderator na spletnem mestu minimiziral
Ta skript je odličen in funkcionalen za tisto, kar sem iskal. Ali je možno, da se koda razlikuje, če je sporočilo novo ali odgovor, pa tudi e-poštna domena? Na primer, če želite nadalje izbrati ločen podpis za odgovore zunanjim prejemnikom v primerjavi z novim sporočilom zunanjim prejemnikom?
Hvala za delitev.
Ta komentar je moderator na spletnem mestu minimiziral
Živjo Seth, spodnja koda razlikuje, ali je sporočilo novo ali odgovor za vstavljanje podpisa. Ročno morate spremeniti "Email naslov"In"E-poštni naslov za odgovor" in ustrezna imena podpisov v kodi.
Private Sub Application_ItemSend (ByVal Element kot predmet, Prekliči kot Boolean)
'Posodobil ExtendOffice 2020 / 12 / 24
Zatemni xMailItem kot MailItem
Dim xRecipients kot prejemniki
Dim xRecipient kot prejemnik
Dim xRcpAddress kot niz
Dim xSignatureFile, xSignaturePath kot niz
Zatemni xFSO kot Scripting.FileSystemObject
Dim xDoc kot dokument
On Error Resume Next
Nastavite xFSO = New Scripting.FileSystemObject
Če Item.Class <> olMail Nato Exit Sub
Nastavite xMailItem = Predmet
Nastavite xRecipients = xMailItem.Recipients
xSignaturePath = CreateObject("WScript.Shell").SpecialFolders(5) + "\Microsoft\Signatures\"
Če InStr(xMailItem.Subject, "RE: ") <> 1 Potem
Za vsakega xRecipient v xRecipients
Če je xRecipient.AddressEntry.AddressEntryUserType = olExchangeUserAddressEntry, potem
xRcpAddress = xRecipient.AddressEntry.GetExchangeUser.PrimarySmtpAddress
Else
xRcpAddress = xRecipient.AddressEntry.Address
Konec Če
Izberite Case xRcpAddress
Ovitek "E-poštni naslov 1"
xSignatureFile = xSignaturePath & "aaa.htm"
Izhod za
Ovitek "E-poštni naslov 2""E-poštni naslov 3"
xSignatureFile = xSignaturePath & "bbb.htm"
Izhod za
Ovitek "E-poštni naslov 4"
xSignatureFile = xSignaturePath & "ccc.htm"
Izhod za
Konec Izberi
Naslednji
Else
Za vsakega xRecipient v xRecipients
Če je xRecipient.AddressEntry.AddressEntryUserType = olExchangeUserAddressEntry, potem
xRcpAddress = xRecipient.AddressEntry.GetExchangeUser.PrimarySmtpAddress
Else
xRcpAddress = xRecipient.AddressEntry.Address
Konec Če
Izberite Case xRcpAddress
Primer "b"
xSignatureFile = xSignaturePath & "111.htm" '111.htm je ime podpisa, ki ga boste vstavili, ko boste odgovorili na "E-poštni naslov za odgovor 1"
Izhod za
Ovitek "E-poštni naslov za odgovor 2""E-poštni naslov za odgovor 3"
xSignatureFile = xSignaturePath & "222.htm"
Izhod za
Ovitek "E-poštni naslov za odgovor 4"
xSignatureFile = xSignaturePath & "333.htm"
Izhod za
Konec Izberi
Naslednji
Konec Če
VBA.DoEvents
Nastavite xDoc = xMailItem.GetInspector.WordEditor
xDoc.Application.Selection.EndKey
xDoc.Application.Selection.InsertParagraphAfter
xDoc.Application.Selection.MoveDown Enota:=wdLine, Število:=1
xDoc.Application.Selection.InsertFile FileName:=xSignatureFile, Link:=False, Attachment:=False
End Sub
Ta komentar je moderator na spletnem mestu minimiziral
Ta koda mi je delovala, dokler nisem znova zagnal računalnika. Ko znova odprem alt+F11, je vsa koda še vedno na istem mestu, ko pa pošljem e-pošto, jo pošlje brez podpisa in brez kakršne koli izdaje opozorilnega sporočila.
Ta komentar je moderator na spletnem mestu minimiziral
Živjo Ivan, težavo je povzročilo, da je Excel onemogočil možnost makro. V okno Outlookovih možnosti morate priti s klikom file > možnosti. v Outlook Možnosti okno, kliknite Trust Center v levem podoknu in nato kliknite Trust Center Nastavitve gumb. V Ljubljani Trust Center okno, kliknite Nastavitve makrov v levem podoknu in nato izberite Omogoči vse makre izbirni gumb in preverite Uporabite varnostne nastavitve makrov za nameščene dodatke škatla. Oglejte si priloženi posnetek zaslona spodaj.
Ta komentar je moderator na spletnem mestu minimiziral
Pozdravljeni Crystal,
Imam vprašanje o spodnji izvorni kodi.
Rad bi poslal interni podpis samo določenim prejemnikom e-pošte (30), takoj ko je dodan še en elektronski naslov, je treba uporabiti zunanji podpis.
Ali mi lahko pomagate z mojo prošnjo?
Že vnaprej se vam zahvaljujem.
Ta komentar je moderator na spletnem mestu minimiziral
V Outlooku imam nastavljenih več e-poštnih računov in imam nastavljen vaš skript za pošiljanje različnih podpisov na notranjo in zunanjo e-pošto.

Kako lahko spremenim skript, da bo pošiljal te podpise samo, če pošiljam z jweaver@andrewslogistics.com?

Z drugimi besedami, ne želim poslati teh podpisov, ko pošiljam z e-poštnega naslova, ki ni jweaver@andrewslogistics.com.

Hvala,
Ta komentar je moderator na spletnem mestu minimiziral
Živjo Jeff Weaver,
Naslednja koda VBA je bila spremenjena za vstavljanje teh podpisov pri pošiljanju e-pošte samo iz določenega e-poštnega računa. Prosim, poskusite. upam, da lahko pomagam.
Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
'Updated by ExtendOffice 2022/06/10
Dim xMailItem As MailItem
Dim xRecipients As Recipients
Dim xRecipient As Recipient
Dim xRcpAddress As String
Dim xSignatureFile, xSignaturePath As String
Dim xFSO As Scripting.FileSystemObject
Dim xDoc As Document
On Error Resume Next
Set xFSO = New Scripting.FileSystemObject
If Item.Class <> olMail Then Exit Sub
Set xMailItem = Item
If xMailItem.SendUsingAccount.SmtpAddress <> "jweaver@andrewslogistics.com" Then Exit Sub 'The email account you send emails from
Set xRecipients = xMailItem.Recipients
xSignaturePath = CreateObject("WScript.Shell").SpecialFolders(5) + "\Microsoft\Signatures\"
For Each xRecipient In xRecipients
    If xRecipient.AddressEntry.AddressEntryUserType = olExchangeUserAddressEntry Then
        xRcpAddress = xRecipient.AddressEntry.GetExchangeUser.PrimarySmtpAddress
    Else
        xRcpAddress = xRecipient.AddressEntry.Address
    End If
    Select Case xRcpAddress
        Case "Email Address 1"
            xSignatureFile = xSignaturePath & "aaa.htm"
            Exit For
        Case "Email Address 2", "Email Address 3"
            xSignatureFile = xSignaturePath & "bbb.htm"
            Exit For
        Case "Email Address 4"
            xSignatureFile = xSignaturePath & "ccc.htm"
            Exit For
    End Select
Next
VBA.DoEvents
Set xDoc = xMailItem.GetInspector.WordEditor
xDoc.Application.Selection.EndKey
xDoc.Application.Selection.InsertParagraphAfter
xDoc.Application.Selection.MoveDown Unit:=wdLine, Count:=1
xDoc.Application.Selection.InsertFile FileName:=xSignatureFile, Link:=False, Attachment:=False
End Sub
Ta komentar je moderator na spletnem mestu minimiziral
Živjo Crystal - tudi jaz imam enako težavo kot Tim (#33997) in Greg (#34358), omenjena zgoraj, vendar ne vidim rešitve. Podpis se pojavi v mojem e-poštnem sporočilu na zadnjem mestu, ki ga kliknem, preden pritisnem »pošlji«, zato se pogosto pojavi na sredini e-pošte. Kakšna pomoč/rešitve?

Hvala!

Eric
Ta komentar je moderator na spletnem mestu minimiziral
Živjo Eric Anderson,
Hvala za vaše mnenje. Koda je zdaj posodobljena in težava je odpravljena. Prosim, poskusite.
Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
'Updated by ExtendOffice 2022/6/24
Dim xMailItem As MailItem
Dim xRecipients As Recipients
Dim xRecipient As Recipient
Dim xRcpAddress As String
Dim xSignatureFile, xSignaturePath As String
Dim xFSO As Scripting.FileSystemObject
Dim xDoc As Document
On Error Resume Next
Set xFSO = New Scripting.FileSystemObject
If Item.Class <> olMail Then Exit Sub
Set xMailItem = Item
Set xRecipients = xMailItem.Recipients
xSignaturePath = CreateObject("WScript.Shell").SpecialFolders(5) + "\Microsoft\Signatures\"
For Each xRecipient In xRecipients
    If xRecipient.AddressEntry.AddressEntryUserType = olExchangeUserAddressEntry Then
        xRcpAddress = xRecipient.AddressEntry.GetExchangeUser.PrimarySmtpAddress
    Else
        xRcpAddress = xRecipient.AddressEntry.Address
    End If
    Debug.Print xRcpAddress
    Select Case xRcpAddress
        Case "464653358@qq.com"
            xSignatureFile = xSignaturePath & "aaa.htm"
            Exit For
        Case "siluvia@extendoffice.com", "happy.xuebi@163.com"
            xSignatureFile = xSignaturePath & "bbb.htm"
            Exit For
        Case "happysiluvia@gmail.com"
            xSignatureFile = xSignaturePath & "ccc.htm"
            Exit For
    End Select
Next
VBA.DoEvents
Set xDoc = xMailItem.GetInspector.WordEditor
xDoc.Application.Selection.EndKey Unit:=wdStory, Extend:=wdMove
xDoc.Application.Selection.InsertParagraphAfter
xDoc.Application.Selection.MoveDown Unit:=wdLine, Count:=1
xDoc.Application.Selection.InsertFile FileName:=xSignatureFile, Link:=False, Attachment:=False
End Sub
Ta komentar je moderator na spletnem mestu minimiziral
Pozdravljeni,

Quand je réponds à des mails, la signature automatique s'insère tout en bas, mais j'aimerais qu'elle s'insère en bas de mon message à moi.

Imate rešitev?

Lélian
Ta komentar je moderator na spletnem mestu minimiziral
Živjo LÉLIAN ALEMPS.
Koda VBA je bila posodobljena. Hvala za vaše mnenje. Prosim poskusite.

Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
'Updated by ExtendOffice 2022/08/01
Dim xMailItem As MailItem
Dim xRecipients As Recipients
Dim xRecipient As Recipient
Dim xRcpAddress As String
Dim xSignatureFile, xSignaturePath As String
Dim xFSO As Scripting.FileSystemObject
Dim xDoc As Document
Dim xFindStr As String
On Error Resume Next
Set xFSO = New Scripting.FileSystemObject
If Item.Class <> olMail Then Exit Sub
Set xMailItem = Item
Set xRecipients = xMailItem.Recipients
xSignaturePath = CreateObject("WScript.Shell").SpecialFolders(5) + "\Microsoft\Signatures\"
For Each xRecipient In xRecipients
    If xRecipient.AddressEntry.AddressEntryUserType = olExchangeUserAddressEntry Then
        xRcpAddress = xRecipient.AddressEntry.GetExchangeUser.PrimarySmtpAddress
    Else
        xRcpAddress = xRecipient.AddressEntry.Address
    End If
    Select Case xRcpAddress
        Case "Email Address 1"
            xSignatureFile = xSignaturePath & "aaa.htm"
            Exit For
        Case "Email Address 2", "Email Address 3"
            xSignatureFile = xSignaturePath & "bbb.htm"
            Exit For
        Case "Email Address 4"
            xSignatureFile = xSignaturePath & "ccc.htm"
            Exit For
    End Select
Next
VBA.DoEvents
Set xDoc = xMailItem.GetInspector.WordEditor
xFindStr = "From: " & xMailItem.Recipients.Item(1).Name & " <" & xRcpAddress & ">"
If VBA.InStr(1, xMailItem.Body, xFindStr) <> 0 Then
    xDoc.Application.Selection.HomeKey Unit:=wdStory, Extend:=wdMove
    With xDoc.Application.Selection.Find
        .ClearFormatting
        .Text = xFindStr
        .Execute Forward:=True
    End With
    With xDoc.Application.Selection
        .MoveLeft wdCharacter, 2
        .InsertParagraphAfter
        .MoveDown Unit:=wdLine, Count:=1
    End With
Else
    With xDoc.Application.Selection
        .EndKey Unit:=wdStory, Extend:=wdMove
        .InsertParagraphAfter
        .MoveDown Unit:=wdLine, Count:=1
    End With
End If
xDoc.Application.Selection.InsertFile FileName:=xSignatureFile, Link:=False, Attachment:=False
End Sub
Tu še ni objavljenih komentarjev
Pustite vaše komentarje
Objava kot gost
×
Ocenite to objavo:
0   Znaki
Predlagane lokacije