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

Kako vstaviti podpis Outlooka pri pošiljanju e-pošte v Excelu?

Recimo, da želite poslati e-pošto neposredno v Excelu, kako lahko v e-pošto dodate privzeti Outlookov podpis? Ta članek ponuja dva načina, ki vam pomagata pri dodajanju Outlookovega podpisa pri pošiljanju e-pošte v Excelu.

Pri pošiljanju prek Excelovega VBA v e-poštno sporočilo Outlook vstavite podpis
Enostavno vstavite podpis Outlooka pri pošiljanju e-pošte v Excelu z neverjetnim orodjem

Več vadnic za pošiljanje v Excelu ...


Pri pošiljanju prek Excelovega VBA v e-poštno sporočilo Outlook vstavite podpis

Na delovnem listu je na primer seznam e-poštnih naslovov za pošiljanje e-poštnih sporočil na vse te naslove v Excelu in dodajanje privzetega Outlookovega podpisa v e-poštna sporočila. Uporabite spodnjo kodo VBA, da to dosežete.

1. Odprite delovni list s seznamom e-poštnih naslovov, na katerega želite poslati e-pošto, in pritisnite na druga + F11 ključi.

2. Na odprtju Microsoft Visual Basic za aplikacije okno, kliknite Vstavi > Modul, in nato kopirajte spodnje VBA 2 v okno kode modula.

3. Zdaj morate zamenjati .Telo črta noter VBA 2 s kodo v VBA 1. Po tem premaknite črto .Prikaz pod črto Z xMailOut.

VBA 1: Predloga za pošiljanje e-pošte s privzetim podpisom Outlook v Excelu

.HTMLBody = "This is a test email sending in Excel" & "<br>" & .HTMLBody

VBA 2: Pošljite e-pošto na e-poštne naslove, določene v celicah v Excelu

Sub SendEmailToAddressInCells()
    Dim xRg As Range
    Dim xRgEach As Range
    Dim xRgVal As String
    Dim xAddress As String
    Dim xOutApp As Outlook.Application
    Dim xMailOut As Outlook.MailItem
    On Error Resume Next
    xAddress = ActiveWindow.RangeSelection.Address
    Set xRg = Application.InputBox("Please select email address range", "KuTools For Excel", xAddress, , , , , 8)
    If xRg Is Nothing Then Exit Sub
    Application.ScreenUpdating = False
    Set xOutApp = CreateObject("Outlook.Application")
    Set xRg = xRg.SpecialCells(xlCellTypeConstants, xlTextValues)
    For Each xRgEach In xRg
        xRgVal = xRgEach.Value
        If xRgVal Like "?*@?*.?*" Then
            Set xMailOut = xOutApp.CreateItem(olMailItem)
            With xMailOut
                .To = xRgVal
                .Subject = "Test"
                .Body = "Dear " _
                      & vbNewLine & vbNewLine & _
                        "This is a test email " & _
                        "sending in Excel"
                .Display
                '.Send
            End With
        End If
    Next
    Set xMailOut = Nothing
    Set xOutApp = Nothing
    Application.ScreenUpdating = True
End Sub

Naslednji posnetek zaslona vam lahko pomaga enostavno najti razlike po spremembi kode VBA.

4. Pritisnite F5 tipko za zagon kode. Potem a Kutools za Excel potrditveno polje se prikaže, izberite e-poštne naslove, na katere boste poslali e-pošto, in kliknite OK.

Nato se ustvarijo e-poštna sporočila. Vidite lahko, da je Outlookov privzeti podpis dodan na koncu telesa e-pošte.

Nasvet:

  • 1. Telo e-pošte lahko spremenite v kodo VBA 1 glede na vaše potrebe.
  • 2. Če se po zagonu kode prikaže pogovorno okno z opozorilom, da uporabniško določena vrsta ni definirana, zaprite to pogovorno okno in nato kliknite Orodja > Reference v Microsoft Visual Basic za aplikacije okno. V uvodu Reference - VBAProject okno, preverite Knjižnica predmetov Microsoft Outlook in kliknite OK. Nato znova zaženite kodo.

Enostavno vstavite podpis Outlooka pri pošiljanju e-pošte v Excelu z neverjetnim orodjem

Če ste novinec v VBA, tukaj toplo priporočam Pošlji e-pošto uporabnost Kutools za Excel zate. S to funkcijo lahko enostavno pošiljate e-poštna sporočila na podlagi določenih polj v Excelu in jim dodate podpis Outlooka. Naredite naslednje.

Pred vložitvijo vloge Kutools za ExcelProsim najprej ga prenesite in namestite.

Najprej morate ustvariti poštni seznam z različnimi polji, na podlagi katerih boste pošiljali e-pošto.

Po potrebi lahko ročno ustvarite poštni seznam ali uporabite funkcijo Ustvari poštni seznam, da ga hitro opravite.

1. klik Kutools Plus > Ustvari poštni seznam.

2. V Ljubljani Ustvari poštni seznam v pogovornem oknu določite polja, ki jih potrebujete, izberite, kje želite prikazati seznam, in nato kliknite OK gumb.

3. Zdaj je ustvarjen vzorec poštnega seznama. Ker gre za vzorčni seznam, morate polja spremeniti v določeno potrebno vsebino. (dovoljeno je več vrstic)

4. Po tem izberite celoten seznam (vključite glave), kliknite Kutools Plus > Pošlji e-pošto.

5. V Ljubljani Pošlji e-pošto pogovorno okno:

  • 5.1) Elementi na izbranem poštnem seznamu se samodejno postavijo v ustrezna polja;
  • 5.2) Dokončajte telo e-pošte;
  • 5.3) Preverite oba Pošljite e-pošto prek Outlooka in Uporabite Outlookove nastavitve podpisa škatle;
  • 5.4) Kliknite Pošlji . Oglejte si posnetek zaslona:

Zdaj so poslana e-poštna sporočila. In privzeti podpis za Outlook je dodan na koncu telesa e-pošte.

  Če želite imeti brezplačen preizkus (30-dan) tega pripomočka, kliknite, če ga želite prenestiin nato nadaljujte z uporabo postopka v skladu z zgornjimi koraki.


Sorodni članki:

Pošljite e-pošto na e-poštne naslove, določene v celicah v Excelu
Recimo, da imate seznam e-poštnih naslovov in želite poslati e-poštno sporočilo v večjem obsegu neposredno v Excelu. Kako to doseči? V tem članku so prikazani načini pošiljanja e-pošte na več e-poštnih naslovov, ki so navedeni v celicah v Excelu.

Pošljite e-pošto s kopiranjem in lepljenjem določenega obsega v telo e-pošte v Excelu
V mnogih primerih je lahko določen obseg vsebine na Excelovem delovnem listu koristen pri e-poštni komunikaciji. V tem članku bomo predstavili način pošiljanja e-pošte z določenim obsegom lepljenja v telo e-pošte neposredno v Excelu.

Pošljite e-pošto z več prilogami, priloženimi v Excelu
Ta članek govori o pošiljanju e-pošte prek Outlooka z več prilogami, priloženimi v Excelu.

Pošljite e-pošto, če je v Excelu potekel rok zapadlosti
Če je na primer datum zapadlosti v stolpcu C manjši ali enak 7 dnevom (trenutni datum je 2017/9/13), pošljite e-poštni opomnik določenemu prejemniku v stolpcu A z določeno vsebino v stolpcu B. Kako ga doseči? V tem članku je predstavljena metoda VBA za podrobno obravnavo.

Samodejno pošlji e-pošto na podlagi vrednosti celice v Excelu
Recimo, da želite poslati e-poštno sporočilo prek Outlooka določenemu prejemniku na podlagi določene vrednosti celice v Excelu. Če je na primer vrednost celice D7 na delovnem listu večja od 200, se e-poštno sporočilo ustvari samodejno. Ta članek predstavlja metodo VBA za hitro reševanje te težave.

Več vadnic za pošiljanje v Excelu ...


Najboljša orodja za pisarniško produktivnost

Kutools za Excel rešuje večino vaših težav in poveča vašo produktivnost za 80%

  • Ponovna uporaba: Hitro vstavite zapletene formule, grafikoni in vse, kar ste že uporabljali; Šifriraj celice z geslom; Ustvari poštni seznam in pošiljanje e-pošte ...
  • Vrstica Super Formula (enostavno urejanje več vrstic besedila in formule); Bralna postavitev (enostavno branje in urejanje velikega števila celic); Prilepite v filtrirani obseg...
  • Združi celice / vrstice / stolpce brez izgube podatkov; Vsebina razdeljenih celic; Združi podvojene vrstice / stolpce... prepreči podvojene celice; Primerjaj obsege...
  • Izberite Duplicate ali Unique Vrstice; Izberite prazne vrstice (vse celice so prazne); Super Find in Fuzzy Find v mnogih delovnih zvezkih; Naključna izbira ...
  • Natančna kopija Več celic brez spreminjanja sklica formule; Samodejno ustvarjanje referenc na več listov; Vstavi oznake, Potrditvena polja in še več ...
  • Izvleček besedila, Dodaj besedilo, Odstrani po položaju, Odstrani presledek; Ustvari in natisni vmesne seštevke strani Pretvarjanje med vsebino celic in komentarji...
  • Super filter (shranite in uporabite sheme filtrov za druge liste); Napredno razvrščanje glede na mesec / teden / dan, pogostost in drugo; Poseben filter s krepko, ležeče ...
  • Združite delovne zvezke in delovne liste; Spoji tabele na podlagi ključnih stolpcev; Razdelite podatke na več listov; Paketna pretvorba xls, xlsx in PDF...
  • Več kot 300 zmogljivih funkcij. Podpira Office / Excel 2007-2021 in 365. Podpira vse jezike. Enostavna uvedba v vašem podjetju ali organizaciji. 30-dnevna brezplačna preizkusna različica vseh funkcij. 60-dnevna garancija vračila denarja.
zavihek kte 201905

Kartica Office prinaša vmesnik z zavihki v Office in poenostavi vaše delo

  • Omogočite urejanje in branje z zavihki v Wordu, Excelu, PowerPointu, Publisher, Access, Visio in Project.
  • Odprite in ustvarite več dokumentov v novih zavihkih istega okna in ne v novih oknih.
  • Poveča vašo produktivnost za 50%in vsak dan zmanjša na stotine klikov miške za vas!
dno pisarniške mize
Komentarji (29)
Ocene še ni. Bodite prvi in ​​ocenite!
Ta komentar je moderator na spletnem mestu minimiziral
najlepša hvala, s to predlogo si mi rešil življenje :D
Ta komentar je moderator na spletnem mestu minimiziral
Dragi Favio,
Z veseljem pomagam.
Ta komentar je moderator na spletnem mestu minimiziral
ne deluje s prilogami v Officeu 2016
Ta komentar je moderator na spletnem mestu minimiziral
Dragi Chris,
Spodnja koda VBA vam lahko pomaga. Ko zaženete kodo, izberite celice z e-poštnimi naslovi, na katere boste pošiljali e-pošto, in nato izberite datoteke, ki jih morate priložiti v e-poštno sporočilo kot priloge, ko se prikaže drugo pogovorno okno. Privzeti podpis Outlooka bo prikazan tudi v telesu e-pošte. Hvala za vaš komentar.

Sub SendEmailToAddressInCells()
Dim xRg As Range
Dim xRgEach kot obseg
Dim xRgVal kot niz
Dim xAddress kot niz
Zatemni xOutApp kot Outlook.Application
Zatemni xMailOut kot Outlook.MailItem
On Error Resume Next
xAddress = ActiveWindow.RangeSelection.Address
Nastavite xRg = Application.InputBox("Prosim, izberite obseg e-poštnih naslovov", "KuTools For Excel", xAddress, , , , , 8)
Če xRg ni nič, zapustite Sub
Application.ScreenUpdating = Napačno
Nastavi xOutApp = CreateObject("Outlook.Application")
Nastavi xRg = xRg.SpecialCells(xlCellTypeConstants, xlTextValues)
Nastavite xFileDlg = Application.FileDialog(msoFileDialogFilePicker)
Če je xFileDlg.Show = -1 Potem
Za vsak xRgEach In xRg
xRgVal = xRgEach.Value
Če je xRgVal všeč "?*@?*.?*" Potem
Nastavi xMailOut = xOutApp.CreateItem(olMailItem)
Z xMailOut
.Prikaz
.To = xRgVal
.Subject = "Test"
.HTMLBody = "To je testna e-pošta, ki se pošilja v Excelu" & "
" & .HTMLtelo
Za vsak xFileDlgItem v xFileDlg.SelectedItems
.Priloge.Dodaj xFileDlgItem
Naslednji xFileDlgItem
'.Pošlji
Končaj s
Konec Če
Naslednji
Nastavite xMailOut = Nič
Nastavite xOutApp = Nič
Application.ScreenUpdating = Res
Konec Če
End Sub
Ta komentar je moderator na spletnem mestu minimiziral
Poskušam dodati podpis Outlooka z naslovom "privzeto", vendar se ne zdi, da deluje.
lahko prosim pomagate? Verjamem, da je moja "xMailout" logika napačna. to je moje domnevno okvarjeno območje.

Zasebni podukazni gumb1_Klik()

Zatemnite xOutApp kot objekt
Zatemni xOutMail kot objekt
Zatemni xMailBody kot niz
Zatemni xMailOut kot Outlook.MailItem
On Error Resume Next
Nastavi xOutApp = CreateObject("Outlook.Application")
Nastavi xOutMail = xOutApp.CreateItem(0)
xMailBody = "Pozdravljeni:" & vbNewLine & vbNewLine & _
"To je vrstica 1" & vbNewLine & _
"To je vrstica 2" & vbNewLine & _
"To je vrstica 3" & vbNewLine & _
"To je vrstica 4"
On Error Resume Next
Z xOutMail
.To = "E-pošta.tukaj.com"
.CC = "E-pošta.tukaj.com"
.Subject = "Tukaj naslov e-pošte - " & obseg("Cell#").value
.Telo = xMailBody
. Priloge.Dodaj ActiveWorkbook.FullName
Nastavi xMailOut = xOutApp.CreateItem(olMailItem)
Z xMailOut
.Prikaz
Končaj s
ActiveWorkbook.Save
Ob napaki Pojdi na 0
Nastavite xOutMail = Nič
Nastavite xOutApp = Nič
End Sub
Ta komentar je moderator na spletnem mestu minimiziral
Dober dan,
Vaš skript je bil spremenjen, poskusite. Hvala vam.

Zasebni podukazni gumb1_Klik()
Zatemnite xOutApp kot objekt
Zatemni xOutMail kot objekt
Zatemni xMailBody kot niz
Zatemni xMailOut kot Outlook.MailItem
On Error Resume Next
Nastavi xOutApp = CreateObject("Outlook.Application")
Nastavi xOutMail = xOutApp.CreateItem(0)
xMailBody = "Pozdravljeni:" & vbNewLine & vbNewLine & _
"To je vrstica 1" & vbNewLine & _
"To je vrstica 2" & vbNewLine & _
"To je vrstica 3" & vbNewLine & _
"To je vrstica 4"
On Error Resume Next
Z xOutMail
.To = "E-pošta.tukaj.com"
.CC = "E-pošta.tukaj.com"
.Subject = "Tukaj naslov e-pošte - " & obseg("Cell#").Vrednost
.Telo = xMailBody
.Priloge.Dodaj ActiveWorkbook.FullName
Nastavi xMailOut = xOutApp.CreateItem(olMailItem)
Z xMailOut
.Prikaz
Končaj s
Končaj s
ActiveWorkbook.Save
Ob napaki Pojdi na 0
Nastavite xOutMail = Nič
Nastavite xOutApp = Nič
End Sub
Ta komentar je moderator na spletnem mestu minimiziral
kako dodati podpis, če makro uporablja več uporabnikov.
na primer moj makro bodo izvajale tudi 3 druge osebe. Torej, kako lahko makro uporablja podpis uporabnika, ki izvaja makro.
Hvala vnaprej
Ta komentar je moderator na spletnem mestu minimiziral
Dober dan,
Koda VBA lahko samodejno prepozna privzeti podpis v Outlooku pošiljatelja in pošlje e-pošto z lastnim podpisom prek Outlooka.
Ta komentar je moderator na spletnem mestu minimiziral
Če je moje telo besedilo povezano z vlečenjem iz polj excel, uporaba & .HTMLBody na koncu niza izbriše celotno telo besedila in pusti samo podpis.
Ta komentar je moderator na spletnem mestu minimiziral
Imam težave pri izvajanju tega v Excelu 2016. Dobim sporočilo »Napaka pri prevajanju: uporabniško določena vrsta ni definirana«. Prosim pomagajte!
Ta komentar je moderator na spletnem mestu minimiziral
Super!!!!
Ta komentar je moderator na spletnem mestu minimiziral
Najlepša hvala...
Ta komentar je moderator na spletnem mestu minimiziral
Živjo, potreboval bi pomoč pri svojem makru, pod mizo moram vstaviti Outlookov podpis, mi lahko pomagate pri tem?

Zasebni podukazni gumb1_Klik()


Zatemnjen pogled kot objekt
Zatemni novoE-pošta kot predmet
Zatemni xPreglejte kot predmet
Zatemni urejevalnik strani kot objekt

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

Z novo e-pošto
.To = Sheet5.Range("F1")
.CC = ""
.BCC = ""
.Subject = Sheet5.Range("B5")
.Body = Sheet5.Range("B41")
.prikaz

Nastavite xInspect = newEmail.GetInspector
Nastavi urejevalnik strani = xInspect.WordEditor

List5.Razpon("B6:I7").Kopiraj

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

.prikaz
Nastavi urejevalnik strani = Nič
Nastavite xInspect = Nič
Končaj s

Nastavi novoEmail = Nič
Nastavite obete = Nič

End Sub
Ta komentar je moderator na spletnem mestu minimiziral
Živjo Bara,
Žal ti pri tem ne morem pomagati. Hvala za vaš komentar.
Ta komentar je moderator na spletnem mestu minimiziral
Dragi,
Mi lahko kdo pomaga z mojim VBA,
Potrebujem podpis v ustvarjenem elektronskem sporočilu:
Ta komentar je moderator na spletnem mestu minimiziral
Zahvaljujoč tebi lahko zdaj dodam podpis, potem pa odstrani presledke med odstavki besedila. Prosim, mi lahko pomagate?


pod helloworld()
Zatemnite OutApp kot objekt
Zatemni OutMail kot predmet
Zatemnjena celica kot obseg
Zatemnjena pot kot niz
Pot = Application.ActiveWorkbook.Path
Nastavi OutApp = CreateObject("Outlook.Application")

Za vsako celico v obsegu ("C4:C6")
Nastavi OutMail = OutApp.CreateItem(0)
Z OutMail
.Prikaz
.To = celica.Vrednost
.Zadeva = Celice(celica.Vrstica, "D").Vrednost
.HTMLBody = "Spoštovani " & celice(cell.Row, "B").Value & "," _
& vbNewLine & vbNewLine & _
"Topli pozdravi" _
& vbNewLine & vbNewLine & _
"Mi, JK Overseas, bi radi izkoristili priložnost in predstavili naše podjetje JK Overseas, ki se s solno dejavnostjo ukvarja zadnja 3 leta. Trenutno smo močni na domačem področju in se širimo v tujino. Smo dobavitelj jedilne soli, Sol za mehčanje vode, sol za razledenitev, industrijska sol" & "." _
& vbNewLine & vbNewLine & _
"Povezani smo z velikimi proizvajalci v Indiji in od njih nabavljamo kakovostno sol in izvoz. Zato iščemo zanesljivega strokovnega uvoznika in distributerja za dolgoročno poslovanje z obojestransko koristjo" & " ." _
& vbNewLine & vbNewLine & _
"Prosimo, kontaktirajte nas glede vaših zahtev ali za morebitna druga vprašanja. Nudimo zanesljivo logistiko in pravočasno dostavo. Prepričani smo, da bodo naše najbolj konkurenčne cene ustrezale vašim pričakovanjem" & "." _
& vbNewLine & vbNewLine & _
.HTMLTelo

'.Pošlji
Končaj s
Naslednja celica
End Sub
Ta komentar je moderator na spletnem mestu minimiziral
Poskušam integrirati to kodo v trenutno obliko, ki jo trenutno imam, s katero lahko avtomatiziram e-pošto v excelu na podlagi nastavljenega obsega vrednosti. Vsaka pomoč v zvezi s tem, kje dodati "podpisno" kodo v tisto, kar trenutno imam, bi bila zelo hvaležna.

Javni sub CheckAndSendMail()

'Posodobil Extendoffice 2018 / 11 / 22

Zatemni xRgDate kot obseg

Zatemni xRgSend As Range

Zatemni xRgText kot obseg

Dim xRgDone As Range

Zatemnite xOutApp kot objekt

Zatemni xMailItem kot objekt

Zatemni xLastRow tako dolgo

Dim vbCrLf kot niz

Zatemni xMailBody kot niz

Dim xRgDateVal kot niz

Dim xRgSendVal kot niz

Zatemni xMailSubject kot niz

Dim I As Long

On Error Resume Next

„Prosimo, navedite obdobje zapadlosti

xStrRang = "D2:D110"

Nastavi xRgDate = Obseg(xStrRang)

»Prosimo, navedite obseg e-poštnih naslovov prejemnikov

xStrRang = "C2:C110"

Nastavite xRgSend = Range(xStrRang)

xStrRang = "A2:A110"

Nastavite xRgName = Range(xStrRang)

»Določite obseg z opomnjeno vsebino v e-pošti

xStrRang = "Z2:Z110"

Nastavi xRgText = Obseg(xStrRang)

xLastRow = xRgDate.Rows.Count

Nastavi xRgDate = xRgDate(1)

Nastavi xRgSend = xRgSend(1)

Nastavi xRgName = xRgName(1)

Nastavi xRgText = xRgText(1)

Nastavi xOutApp = CreateObject("Outlook.Application")

Za I = 1 do xLastRow

xRgDateVal = ""

xRgDateVal = xRgDate.Offset(I - 1).Vrednost

Če je xRgDateVal <> "" Potem

Če je CDate(xRgDateVal) - Datum <= 30 In CDate(xRgDateVal) - Datum > 0, potem

xRgSendVal = xRgSend.Offset(I - 1).Vrednost

xMailSubject = " Pogodba o storitvi JBC poteče dne " & xRgDateVal

vbCrLf = "

"

xMailBody = ""

xMailBody = xMailBody & "Dear " & xRgName.Offset(I - 1).Value & vbCrLf

xMailBody = xMailBody & " " & xRgText.Offset(I - 1).Value & vbCrLf

xMailBody = xMailBody & ""

Nastavi xMailItem = xOutApp.CreateItem(0)

Z xMailItemom

.Zadeva = xMailSubject

.Za = xRgSendVal

.CC = "mailcc@justbettercare.com"

.HTMLBody = xMailBody

.Prikaz

'.Pošlji

Končaj s

Nastavite xMailItem = Nič

Konec Če

Konec Če

Naslednji

Nastavite xOutApp = Nič

End Sub
Ta komentar je moderator na spletnem mestu minimiziral
To je res koristna koda
V vrstici xOutMsg moram spremeniti obliko besedila od desne proti levi
pomagaj prosim .
Ta komentar je moderator na spletnem mestu minimiziral
Poskušam poslati posamezne liste iz excela na različna e-poštna sporočila, vendar bo priložil samo delovni zvezek. Prav tako moram imeti možnost dodati vrstico za podpis. Kakšna pomoč?Pošlji AST_Email_From_Excel()

Zatemni e-poštna aplikacija kot predmet
Zatemni emailItem kot predmet

Nastavi emailApplication = CreateObject("Outlook.Application")
Nastavi emailItem = emailApplication.CreateItem(0)

' Zdaj gradimo e-pošto.

emailItem.to = Obseg("e2").Vrednost

emailItem.CC = Obseg("g2").Vrednost

emailItem.Subject = "Nevrnjena tehnična oprema"

emailItem.Body = "Oglejte si priloženo preglednico za nevrnjene artikle na vašem območju"

»Priloži trenutni delovni zvezek
emailItem.Attachments.Add ActiveWorkbook.FullName

»Priložite katero koli datoteko iz računalnika.
'emailItem.Attachments.Add ("C:\...)"

'Pošlji e-pošto
'emailItem.send

»Prikaži e-poštno sporočilo, da ga lahko uporabnik po želji spremeni pred pošiljanjem
emailItem.Display

Nastavi emailItem = Nič
Nastavite emailApplication = Nič

End Sub
Ta komentar je moderator na spletnem mestu minimiziral
Živjo Chris, koda, ki ste jo navedli, je bila spremenjena. Outlookov podpis je zdaj mogoče vstaviti v telo sporočila. Prosim, poskusite. Hvala vam. Sub AST_Email_From_Excel()
'Posodobil Extendoffice 20220211
Zatemni e-poštna aplikacija kot predmet
Zatemni emailItem kot predmet
Nastavi emailApplication = CreateObject("Outlook.Application")
Nastavi emailItem = emailApplication.CreateItem(0)

' Zdaj gradimo e-pošto.
emailItem.Display 'Prikaži e-pošto, tako da jo lahko uporabnik spremeni po želji pred pošiljanjem
emailItem.to = Obseg("e2").Vrednost
emailItem.CC = Obseg("g2").Vrednost
emailItem.Subject = "Nevrnjena tehnična oprema"
emailItem.HTMLBody = "Oglejte si priloženo preglednico za nevrnjene artikle na vašem območju" & " " & emailItem.HTMLBody

»Priloži trenutni delovni zvezek
emailItem.Attachments.Add ActiveWorkbook.FullName

Nastavi emailItem = Nič
Nastavite emailApplication = Nič

End Sub
Ta komentar je moderator na spletnem mestu minimiziral
Živjo Crystal, hvala, ker ste ga pripravili za dodajanje podpisa, zdi se, da razdelek HTMLBody ni všeč. Ko zaženem makro, odpravlja napake na emailItem.HTMLBody = "Oglejte si priloženo preglednico za nevrnjene elemente na vašem območju" & " " & emailItem.HTMLBodyand ne dokonča preostalega.  
Ta komentar je moderator na spletnem mestu minimiziral
Hi,
Katero različico Excela uporabljate? V pomoč je lahko tudi naslednja koda VBA. Prosim, poskusite. Hvala za povratne informacije. Sub SendWorkSheet()
'Posodobite do Extendoffice 20220218
Zatemni xFile kot niz
Dim xFormat As Long
Dim Wb kot delovni zvezek
Dim Wb2 kot delovni zvezek
Dim FilePath kot niz
Zatemni ime datoteke kot niz
Zatemnite OutlookApp kot objekt
Zatemnite OutlookMail kot predmet
On Error Resume Next
Application.ScreenUpdating = Napačno
Nastavite Wb = Application.ActiveWorkbook
ActiveSheet.Copy
Nastavite Wb2 = Application.ActiveWorkbook
Izberite Case Wb.FileFormat
Primer xlOpenXMLWorkbook:
xFile = ".xlsx"
xFormat = xlOpenXMLWorkbook
Primer xlOpenXMLWorkbookMacroEnabled:
Če Wb2.HasVBProject Potem
xFile = ".xlsm"
xFormat = xlOpenXMLWorkbookMacroEnabled
Else
xFile = ".xlsx"
xFormat = xlOpenXMLWorkbook
Konec Če
Primer Excel8:
xFile = ".xls"
xFormat = Excel8
Primer xlExcel12:
xFile = ".xlsb"
xFormat = xlExcel12
Konec Izberi
FilePath = Environ$("temp") & "\"
FileName = Wb.Name & Format(Zdaj, "dd-mmm-yy h-mm-ss")
Nastavi OutlookApp = CreateObject("Outlook.Application")
Nastavi OutlookMail = OutlookApp.CreateItem(0)
Wb2.SaveAs FilePath & FileName & xFile, FileFormat:=xFormat
'xstr = Obseg("e2") & " ; " & Obseg("g2")
Z OutlookMail
.Prikaz
.To = Obseg("e2")
.CC = Obseg("g2")
.BCC = ""
.Subject = "Nevrnjena tehnična oprema"
.HTMLBody = "Oglejte si priloženo preglednico za nevrnjene artikle na vašem območju" & " " & .HTMLtelo
.Priloge.Dodaj Wb2.FullName
'.Pošlji
Končaj s
Wb2.Zapri
Kill FilePath & FileName & xFile
Nastavite OutlookMail = Nič
Nastavite OutlookApp = Nič
Application.ScreenUpdating = Res
End Sub
Ta komentar je moderator na spletnem mestu minimiziral
Videti je, da je Excel 2016 in VBA 7.1
Ta komentar je moderator na spletnem mestu minimiziral
Oi Cristal, majhen makro za konfiguracijo e-pošte, slike in formatiranje originala. Como consigo razreševalec?

Sub Geraremail()

Zatemni OLapp kot Outlook.Application
Dim janela Kot Outlook.MailItem

Nastavite OLapp = New Outlook.Application
Nastavi janela = OLapp.CreateItem(olMailItem)

Arquivo01 = "Mapa AN"
Anexo01 = ThisWorkbook.Path & "\" & Arquivo01 & ".xlsm"


Z Janelo
ActiveWorkbook.Save
.Prikaz
.To = Listi("Osnova").Razpon("A2").Vrednost
.CC = Listi("Osnova").Razpon("A5").Vrednost
.Subject = "Mapa - Acrilo " & Format (datum, "dd.mm.ll")
assinatura = .Telo
.Body = "Prezados/as," & Chr(10) & Chr(10) & "Segue anexo o mapa de Acrilonitrila considerando as vendas previstas no S&OP." & Chr(10) & Chr(10) & assinatura
.Priloge.Dodaj Anexo01
Končaj s

End Sub
Ta komentar je moderator na spletnem mestu minimiziral
Com a mudança abaixo, consegui ajustar. Porém a letra do corpo da mensagem fica em Times New Roman. Gostaria de usar Calibri, como posso alterar o código?

Sub Geraremail()

Zatemni OLapp kot Outlook.Application
Dim janela Kot Outlook.MailItem

Nastavite OLapp = New Outlook.Application
Nastavi janela = OLapp.CreateItem(olMailItem)

Arquivo01 = "Mapa AN"
Anexo01 = ThisWorkbook.Path & "\" & Arquivo01 & ".xlsm"


Z Janelo
ActiveWorkbook.Save
.Prikaz
.To = Listi("Osnova").Razpon("A2").Vrednost
.CC = Listi("Osnova").Razpon("A5").Vrednost
.Subject = "Mapa - Acrilo " & Format (datum, "dd.mm.ll")
assinatura = .Telo
.HTMLBody = "Prezados/as," & Chr(10) & Chr(10) & "Segue anexo o mapa de Acrilonitrila considerando as vendas previstas no S&OP." & " " & .HTMLtelo
.Priloge.Dodaj Anexo01
Končaj s

End Sub
Ta komentar je moderator na spletnem mestu minimiziral
Živjo Milla,
Naslednja koda VBA vam lahko pomaga spremeniti pisavo telesa e-pošte v Calibri, poskusite. Hvala vam.
Preden zaženete kodo, morate klikniti Orodja > Reference v Microsoft Visual Basic za aplikacije okno in nato preverite Knjižnica predmetov Microsoft Word potrditveno polje v Reference - VBAProject pogovorno okno, kot je prikazano na spodnjem posnetku zaslona.
[img]I:\工作\周雪明\2022年工作\6月份\文章评论截图\3.png[/img]
Sub Geraremail()
Dim OLapp As Outlook.Application
Dim janela As Outlook.MailItem
Dim xDoc As Document 'Click Tools > Reference to enable the Microsoft Word Object Library
On Error Resume Next
Set OLapp = New Outlook.Application
Set janela = OLapp.CreateItem(olMailItem)
Arquivo01 = "Mapa AN"
Anexo01 = ThisWorkbook.Path & "\" & Arquivo01 & ".xlsm"
With janela
  ActiveWorkbook.Save
  .Display
  .To = Sheets("Base").Range("A2").Value
  .CC = Sheets("Base").Range("A5").Value
  .Subject = "Mapa - Acrilo " & Format(Date, "dd.mm.yy")
   assinatura = .Body
  .HTMLBody = "Prezados/as," & Chr(10) & Chr(10) & "Segue anexo o mapa de Acrilonitrila considerando as vendas previstas no S&OP." & "<br>" & .HTMLBody
  .Attachments.Add Anexo01
End With
Set xDoc = janela.GetInspector.WordEditor
xDoc.Content.Font.Name = "Calibri"
End Sub
Ta komentar je moderator na spletnem mestu minimiziral
Živjo Milla,
Naslednja koda VBA vam lahko pomaga spremeniti pisavo telesa e-pošte v Calibri, poskusite. Hvala vam.
Preden zaženete kodo, morate klikniti Orodja > Reference v Microsoft Visual Basic za aplikacije okno in nato preverite Knjižnica predmetov Microsoft Word potrditveno polje v Reference - VBAProject pogovorno okno kot priložena datoteka, prikazana spodaj.
Sub Geraremail()
Dim OLapp As Outlook.Application
Dim janela As Outlook.MailItem
Dim xDoc As Document 'Click Tools > Reference to enable the Microsoft Word Object Library
On Error Resume Next
Set OLapp = New Outlook.Application
Set janela = OLapp.CreateItem(olMailItem)
Arquivo01 = "Mapa AN"
Anexo01 = ThisWorkbook.Path & "\" & Arquivo01 & ".xlsm"
With janela
  ActiveWorkbook.Save
  .Display
  .To = Sheets("Base").Range("A2").Value
  .CC = Sheets("Base").Range("A5").Value
  .Subject = "Mapa - Acrilo " & Format(Date, "dd.mm.yy")
   assinatura = .Body
  .HTMLBody = "Prezados/as," & Chr(10) & Chr(10) & "Segue anexo o mapa de Acrilonitrila considerando as vendas previstas no S&OP." & "<br>" & .HTMLBody
  .Attachments.Add Anexo01
End With
Set xDoc = janela.GetInspector.WordEditor
xDoc.Content.Font.Name = "Calibri"
End Sub
Ta komentar je moderator na spletnem mestu minimiziral
Pozdravljeni, poskušam popraviti kodo VBA. Rad bi vključil enega od svojih podpisov Outlooka z logotipom. Ali je to mogoče in kam naj dam kodo, ki jo trenutno uporabljam? Vsaka pomoč bi bila super.

Sub EmailAspdf()

Zatemni EApp kot predmet
Nastavi EApp = CreateObject("Outlook.Application")

Zatemni EItem kot predmet
Nastavite EItem = EApp.CreateItem(0)

Dim invno As Long
Zatemni ime po meri kot niz
Dim amt Kot valuta
Dim dt_issue kot datum
Dim termin Kot bajt
Dim nextrec kot obseg
Zatemnjena pot kot niz
Dim fname kot niz

invno = obseg ("I4")
ime po meri = obseg ("A11")
amt = obseg ("I42")
dt_issue = obseg ("I6")
izraz = obseg ("I7")
pot = "moja pot"
fname = invno & " - " & ime po meri

ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, IgnorePrintAreas:=False, Filename:=path & fname

Nastavi nextrec = Sheet3.Range("A1048576").End(xlUp).Offset(1, 0)

nextrec = invno
nextrec.Offset(0, 1) = ime po meri
nextrec.Offset(0, 2) = amt
nextrec.Offset(0, 3) = dt_issue
nextrec.Offset(0, 4) = dt_issue + izraz
nextrec.Offset(0, 8) = Zdaj

Sheet3.Hyperlinks.Add anchor:=nextrec.Offset(0, 6), Address:=path & fname & ".pdf"

Z EItemom

.To = Obseg("A17")

.Subject = Range("A11") & " " & "Št. računa: " & Range("I4") & " " & "za California Advocates"

.body = "Pozdravljeni " & Range("A11") & "," & vbNewLine & vbNewLine _
& "Oglejte si priloženi račun za " & Range("A11") & "." & vbNewLine & vbNewLine _
& "Če imate kakršna koli vprašanja, se obrnite name." & vbNewLine & vbNewLine _
& "Najboljše," & vbNewLine _
& "Mynamehere" & vbNewLine

.Attachments.Add (path & fname & ".pdf")

.Prikaz

Končaj s
Exit Sub



End Sub
Ta komentar je moderator na spletnem mestu minimiziral
Živjo RoseAnne,

Logotip lahko ročno dodate svojemu podpisu vnaprej, preden uporabite kodo VBA. Kodo je treba vnesti v okno kode modula (pritisnite Alt + F11, da odprete urejevalnik Visual Basic, kliknite Vstavi > Moduli)
Tu še ni objavljenih komentarjev
Pustite vaše komentarje
Objava kot gost
×
Ocenite to objavo:
0   Znaki
Predlagane lokacije

Sledi nam

Copyright © 2009 - www.extendoffice.com. | Vse pravice pridržane. Poganja ga ExtendOffice. | Kazalo
Microsoft in logotip Office sta blagovni znamki ali registrirani blagovni znamki družbe Microsoft Corporation v ZDA in / ali drugih državah.
Zaščiteno s Sectigo SSL