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

Excel'de e-posta gönderirken Outlook imzası nasıl eklenir?

Doğrudan Excel'de bir e-posta göndermek istediğinizi varsayalım, e-postaya varsayılan Outlook imzasını nasıl ekleyebilirsiniz? Bu makale, Excel'de e-posta gönderirken Outlook imzası eklemenize yardımcı olacak iki yöntem sunar.

Excel VBA ile gönderirken Outlook e-postasına imza ekleyin
Harika bir araçla Excel'de e-posta gönderirken Outlook imzasını kolayca ekleyin

Excel'de postalama için daha fazla öğretici ...


Excel VBA ile gönderirken Outlook e-postasına imza ekleyin

Örneğin, Excel'de tüm bu adreslere e-posta göndermek ve e-postalara varsayılan Outlook imzasını eklemek için bir çalışma sayfasında bir e-posta adresleri listesi vardır. Bunu başarmak için lütfen aşağıdaki VBA kodunu uygulayın.

1. E-posta göndermek istediğiniz e-posta adresi listesini içeren çalışma sayfasını açın ve ardından Ara Toplam + F11 anahtarlar.

2. Açılışta Uygulamalar için Microsoft Visual Basic Pencere, tıklayın Ekle > Modül, ve sonra aşağıdakileri kopyalayın VBA2 Modül kodu penceresine.

3. Şimdi değiştirmelisiniz .Vücut satır içi VBA2 içindeki kod ile VBA1. Bundan sonra çizgiyi hareket ettirin .Görüntüle çizginin altında XMailOut ile.

VBA 1: Excel'de Outlook varsayılan imzasıyla e-posta gönderme şablonu

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

VBA 2: Excel'deki hücrelerde belirtilen e-posta adreslerine e-posta gönderin

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

Aşağıdaki ekran görüntüsü, VBA kodunu değiştirdikten sonra farklılıkları kolayca bulmanıza yardımcı olabilir.

4. Tuşuna basın. F5 kodu çalıştırmak için anahtar. Sonra bir Kutools for Excel seçim kutusu açılır, lütfen e-postaları göndereceğiniz e-posta adreslerini seçin ve ardından Tamam.

Ardından e-postalar oluşturulur. E-posta gövdesinin sonuna Outlook varsayılan imzasının eklendiğini görebilirsiniz.

İpuçları:

  • 1. VBA kodu 1'deki e-posta gövdesini ihtiyaçlarınıza göre değiştirebilirsiniz.
  • 2. Kodu çalıştırdıktan sonra, Kullanıcı tanımlı türün tanımlanmadığını belirten bir hata iletişim kutusu açılırsa lütfen bu iletişim kutusunu kapatın ve ardından Tools > Referanslar içinde Uygulamalar için Microsoft Visual Basic pencere. Açılışta Referanslar - VBAProject pencere, kontrol edin Microsoft Outlook Nesne Kitaplığı kutu ve tıklayın Tamam. Ve sonra kodu tekrar çalıştırın.

Harika bir araçla Excel'de e-posta gönderirken Outlook imzasını kolayca ekleyin

VBA'da acemi iseniz, burada kesinlikle Mailleri gönder yarar Kutools for Excel senin için. Bu özellik sayesinde, Excel'deki belirli alanlara göre kolayca e-posta gönderebilir ve bunlara Outlook imzası ekleyebilirsiniz. Lütfen aşağıdaki işlemleri yapın.

Başvurmadan önce Kutools for ExcelLütfen önce indirin ve kurun.

Öncelikle e-postaları temel alarak göndereceğiniz farklı alanlar içeren bir mail listesi oluşturmanız gerekir.

İhtiyaç duyduğunuzda manuel olarak bir posta listesi oluşturabilir veya bunu hızlı bir şekilde yapmak için Posta Listesi Oluştur özelliğini uygulayabilirsiniz.

1. tık Kutools Artı > Posta Listesi Oluşturun.

2. içinde Posta Listesi Oluşturun iletişim kutusunda ihtiyacınız olan alanları belirtin, listenin çıktısının nereden alınacağını seçin ve ardından OK düğmesine basın.

3. Şimdi bir posta listesi örneği oluşturulur. Örnek bir liste olduğu için, alanları belirli gerekli içeriklerle değiştirmeniz gerekir. (birden çok satıra izin verilir)

4. Bundan sonra, tüm listeyi seçin (başlıkları dahil edin), tıklayın Kutools Artı > Mailleri gönder.

5. içinde Mailleri gönder iletişim kutusu:

  • 5.1) Seçilen posta listesindeki öğeler otomatik olarak ilgili alanlara yerleştirilir;
  • 5.2) E-posta metnini tamamlayın;
  • 5.3) Her ikisini de kontrol edin Outlook aracılığıyla e-posta gönderin ve Outlook'un imza ayarlarını kullanın kutular;
  • 5.4) Gönder buton. Ekran görüntüsüne bakın:

Şimdi e-postalar gönderiliyor. Ve varsayılan Outlook imzası, e-posta gövdesinin sonuna eklenir.

  Ücretsiz deneme yapmak istiyorsanız (30-gün) bu yardımcı programın, indirmek için lütfen tıklayınızve ardından yukarıdaki adımlara göre işlemi uygulamaya gidin.


İlgili yazılar:

Excel'deki hücrelerde belirtilen e-posta adreslerine e-posta gönderin
Bir e-posta adresleri listeniz olduğunu ve bu e-posta adreslerine doğrudan Excel'de toplu olarak e-posta mesajı göndermek istediğinizi varsayarsak. Nasıl başarılır? Bu makale size Excel'deki hücrelerde belirtilen birden çok e-posta adresine e-posta gönderme yöntemlerini gösterecektir.

Excel'deki e-posta gövdesine belirli bir aralığı kopyalayıp yapıştırarak e-posta gönderin
Çoğu durumda, Excel çalışma sayfasındaki belirli bir içerik aralığı e-posta iletişiminizde yararlı olabilir. Bu makalede, doğrudan Excel'de e-posta gövdesine yapıştırılan belirli aralıklarla bir e-posta gönderme yöntemi tanıtacağız.

Excel'de birden çok ek eklenmiş e-posta gönderin
Bu makale, Outlook üzerinden Excel'de birden çok ek eklenmiş bir e-posta göndermekten bahsediyor.

Excel'de son tarih karşılandıysa e-posta gönderin
Örneğin, C sütunundaki son tarih 7 günden az veya buna eşitse (mevcut tarih 2017/9/13), A sütununda belirtilen alıcıya B sütununda belirtilen içeriğe sahip bir e-posta hatırlatıcısı gönderin başarmak mı? Bu makale, bununla ayrıntılı olarak ilgilenmek için bir VBA yöntemi sağlayacaktır.

Excel'deki hücre değerine göre otomatik olarak e-posta gönderin
Excel'de belirli bir hücre değerine göre Outlook aracılığıyla belirli bir alıcıya bir e-posta göndermek istediğinizi varsayarsak. Örneğin, bir çalışma sayfasındaki D7 hücresinin değeri 200'den büyük olduğunda, otomatik olarak bir e-posta oluşturulur. Bu makale, bu sorunu hızlı bir şekilde çözmeniz için bir VBA yöntemi sunar.

Excel'de postalama için daha fazla öğretici ...


En İyi Ofis Üretkenliği Araçları

Kutools for Excel Sorunlarınızın Çoğunu Çözer ve Verimliliğinizi% 80 Artırır

  • Yeniden: Hızlıca yerleştirin karmaşık formüller, grafikler ve daha önce kullandığınız her şey; Hücreleri Şifrele şifre ile; Posta Listesi Oluşturun ve e-posta gönder ...
  • Süper Formül Çubuğu (birden çok metin ve formül satırını kolayca düzenleyin); Okuma Düzeni (çok sayıda hücreyi kolayca okuyun ve düzenleyin); Filtrelenmiş Aralığa Yapıştır...
  • Hücreleri / Satırları / Sütunları Birleştirme Veri kaybetmeden; Bölünmüş Hücre İçeriği; Yinelenen Satırları / Sütunları Birleştirme... Yinelenen Hücreleri Önleyin; Aralıkları Karşılaştır...
  • Yinelenen veya Benzersiz'i seçin Satırlar; Boş Satırları Seçin (tüm hücreler boştur); Süper Bul ve Bulanık Bul Birçok Çalışma Kitabında; Rastgele Seçim ...
  • Tam kopya Formül referansını değiştirmeden Birden Çok Hücre; Otomatik Referans Oluştur Birden Çok Sayfaya; Madde İşaretleri Ekle, Onay Kutuları ve daha fazlası ...
  • Metni Çıkar, Metin Ekle, Konuma Göre Kaldır, Alanı Kaldır; Sayfalama Alt Toplamları Oluşturma ve Yazdırma; Hücre İçeriği ve Yorumları Arasında Dönüştür...
  • Süper Filtre (filtre şemalarını kaydedin ve diğer sayfalara uygulayın); Gelişmiş Sıralama ay / hafta / gün, sıklık ve daha fazlasına göre; Özel Filtre kalın, italik ...
  • Çalışma Kitaplarını ve Çalışma Sayfalarını Birleştirin; Tabloları anahtar sütunlara göre birleştirin; Verileri Birden Çok Sayfaya Bölme; Toplu dönüştürme xls, xlsx ve PDF...
  • 300'den fazla güçlü özellik. Office / Excel 2007-2021 ve 365'i destekler. Tüm dilleri destekler. Kuruluşunuzda veya kuruluşunuzda kolay devreye alma. Tam özellikler 30 günlük ücretsiz deneme. 60 günlük para iade garantisi.
kte sekmesi 201905

Office Tab, Office'e Sekmeli Arayüz Getirir ve İşinizi Çok Daha Kolay Hale Getirir

  • Word, Excel, PowerPoint'te sekmeli düzenlemeyi ve okumayı etkinleştirin, Publisher, Access, Visio ve Project.
  • Yeni pencereler yerine aynı pencerenin yeni sekmelerinde birden çok belge açın ve oluşturun.
  • Üretkenliğinizi% 50 artırır ve her gün sizin için yüzlerce fare tıklamasını azaltır!
ofis tabanı
Yorumları sıralama ölçütü
Yorumlar (27)
Henüz derecelendirme yok. İlk değerlendiren siz olun!
Bu yorum sitedeki moderatör tarafından en aza indirildi
çok teşekkür ederim, bu şablonla hayatımı kurtardın :D
Bu yorum sitedeki moderatör tarafından en aza indirildi
Sevgili Favio,
Yardımcı olmaktan memnun oldum.
Bu yorum sitedeki moderatör tarafından en aza indirildi
Office 2016'da eklerle çalışmıyor
Bu yorum sitedeki moderatör tarafından en aza indirildi
Sevgili Chris,
Aşağıdaki VBA kodu size yardımcı olabilir. Kodu çalıştırdıktan sonra, lütfen e-posta göndereceğiniz e-posta adreslerini içeren hücreleri seçin ve ardından ikinci iletişim kutusu açıldığında e-postaya ek olarak eklemeniz gereken dosyaları seçin. Ve varsayılan Outlook imzası da e-posta gövdesinde görüntülenecektir. Yorumun için teşekkür ederim.

Alt SendEmailToAddressInCells()
Aralık olarak Dim xRg
Dim xRgEach As Aralık
Dize Olarak Dim xRgVal
Dize Olarak xAddress Dim
Outlook.Application Olarak xOutApp Dim
Outlook.MailItem Olarak xMailOut'u Karartın
On Error Resume Next
xAddress = ActiveWindow.RangeSelection.Address
Set xRg = Application.InputBox("Lütfen e-posta adresi aralığını seçin", "KuTools For Excel", xAddress, , , , , , 8)
xRg Hiçbir Şey Değilse, Sub'dan Çıkın
Application.ScreenUpdating = Yanlış
xOutApp = CreateObject("Outlook.Application") olarak ayarlayın
xRg = xRg.SpecialCells(xlCellTypeConstants, xlTextValues) olarak ayarlayın
xFileDlg = Application.FileDialog(msoFileDialogFilePicker) olarak ayarlayın
xFileDlg.Show = -1 ise
xRg'deki Her xRgEach İçin
xRgVal = xRgEach.Value
Eğer xRgVal "?*@?*.?*" Gibiyse O zaman
xMailOut = xOutApp.CreateItem(olMailItem) olarak ayarlayın
XMailOut ile
.Görüntüle
.To = xRgVal
.Subject = "Test"
.HTMLBody = "Bu, Excel'de gönderilen bir test e-postasıdır" & "
" & .HTMLBody
xFileDlg.SelectedItems içindeki her xFileDlgItem için
.Ekler.xFileDlgItem Ekle
Sonraki xFileDlgItem
'.Göndermek
İle bitmek
Eğer son
Sonraki
xMailOut'u ayarla = Hiçbir şey
xOutApp'ı ayarla = Hiçbir şey
Application.ScreenUpdating = True
Eğer son
End Sub
Bu yorum sitedeki moderatör tarafından en aza indirildi
"varsayılan" başlıklı görünüm imzasını eklemeye çalışıyorum ancak işe yarıyor gibi görünmüyor.
lütfen yardım edebilir misin? "xMailout" mantığımın yanlış olduğuna inanıyorum. bu benim şüpheli hatalı bölgem.

Özel Alt KomutDüğmesi1_Click ()

xOutApp'i Nesne Olarak Karartın
Nesne Olarak xOutMail'i Karartın
Dize olarak xMailBody'yi karart
Outlook.MailItem Olarak xMailOut'u Karartın
On Error Resume Next
xOutApp = CreateObject("Outlook.Application") olarak ayarlayın
xOutMail = xOutApp.CreateItem(0) olarak ayarlayın
xMailBody = "Selamlar:" & vbNewLine & vbNewLine & _
"Bu satır 1" & vbNewLine & _
"Bu satır 2" & vbNewLine & _
"Bu satır 3" & vbNewLine & _
"Bu 4. satır"
On Error Resume Next
xOutMail ile
.To = "Email.here.com"
.CC = "Email.here.com"
.Subject = "E-posta Başlığı Buraya - " & Range("Hücre#").value
.Body = xMailBody
. Ekler.ActiveWorkbook.TamAd Ekle
xMailOut = xOutApp.CreateItem(olMailItem) olarak ayarlayın
XMailOut ile
.Görüntüle
İle bitmek
ActiveWorkbook.Save
Hata Dönüsünde 0
xOutMail'i ayarla = Hiçbir şey
xOutApp'ı ayarla = Hiçbir şey
End Sub
Bu yorum sitedeki moderatör tarafından en aza indirildi
İyi günler,
Komut dosyanız değiştirildi, lütfen deneyin. Teşekkür ederim.

Özel Alt KomutDüğmesi1_Click ()
xOutApp'i Nesne Olarak Karartın
Nesne Olarak xOutMail'i Karartın
Dize olarak xMailBody'yi karart
Outlook.MailItem Olarak xMailOut'u Karartın
On Error Resume Next
xOutApp = CreateObject("Outlook.Application") olarak ayarlayın
xOutMail = xOutApp.CreateItem(0) olarak ayarlayın
xMailBody = "Selamlar:" & vbNewLine & vbNewLine & _
"Bu satır 1" & vbNewLine & _
"Bu satır 2" & vbNewLine & _
"Bu satır 3" & vbNewLine & _
"Bu 4. satır"
On Error Resume Next
xOutMail ile
.To = "Email.here.com"
.CC = "Email.here.com"
.Subject = "E-posta Başlığı Buraya - " & Range("Hücre#").Value
.Body = xMailBody
.Attachments.ActiveWorkbook.FullName ekleyin
xMailOut = xOutApp.CreateItem(olMailItem) olarak ayarlayın
XMailOut ile
.Görüntüle
İle bitmek
İle bitmek
ActiveWorkbook.Save
Hata Dönüsünde 0
xOutMail'i ayarla = Hiçbir şey
xOutApp'ı ayarla = Hiçbir şey
End Sub
Bu yorum sitedeki moderatör tarafından en aza indirildi
makro birden fazla kullanıcı tarafından kullanılıyorsa imza nasıl eklenir.
örneğin benim makrom 3 kişi tarafından daha çalıştırılacak. Peki makro, makroyu çalıştıran kullanıcının imzasını nasıl kullanabilir?
şimdiden teşekkürler
Bu yorum sitedeki moderatör tarafından en aza indirildi
Good Day,
VBA kodu, gönderenin Outlook'taki varsayılan imzasını otomatik olarak tanıyabilir ve Outlook aracılığıyla kendi imzasıyla e-posta gönderebilir.
Bu yorum sitedeki moderatör tarafından en aza indirildi
Gövde metnim excel alanlarından çekmeye bağlıysa, dizenin sonundaki & .HTMLBody kullanımı tüm gövde metnini siler ve yalnızca imzayı bırakır.
Bu yorum sitedeki moderatör tarafından en aza indirildi
Bunu excel 2016'da çalıştırırken sorun yaşıyorum. "Derleme Hatası: Kullanıcı Tanımlı Tür Tanımlanmadı" mesajı alıyorum. Lütfen yardım et!
Bu yorum sitedeki moderatör tarafından en aza indirildi
süper!!!!
Bu yorum sitedeki moderatör tarafından en aza indirildi
Çok teşekkürler ...
Bu yorum sitedeki moderatör tarafından en aza indirildi
Merhaba, makromla ilgili yardıma ihtiyacım olacak, tablonun altına Outlook imzasını eklemem gerekiyor, bu konuda bana yardımcı olabilir misiniz?

Özel Alt KomutDüğmesi1_Click ()


Nesne olarak görünümü karart
Yeni E-postayı Nesne Olarak Karart
Dim xInspect Nesne Olarak
Sayfayı karart Nesne Olarak Düzenleyici

Görünümü ayarla = CreateObject("Outlook.Application")
newEmail = outlook.CreateItem(0) ayarla

YeniE-posta ile
.To = Sheet5.Range("F1")
.CC = ""
.BCC = ""
.Konu = Sheet5.Range("B5")
.Body = Sheet5.Range("B41")
.Görüntüle

xInspect = newEmail.GetInspector olarak ayarlayın
pageEditor'u ayarla = xInspect.WordEditor

Sheet5.Range("B6:I7").Kopyala

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

.Görüntüle
Sayfa Düzenleyicisini ayarla = Hiçbir şey
xInspect'i ayarla = Hiçbir şey
İle bitmek

YeniE-posta ayarla = Hiçbir şey
Görünümü ayarla = Hiçbir şey

End Sub
Bu yorum sitedeki moderatör tarafından en aza indirildi
Merhaba Bara,
Üzgünüm bu konuda size yardımcı olamam. Yorumun için teşekkürler.
Bu yorum sitedeki moderatör tarafından en aza indirildi
Sevgili,
Birisi bana VBA'mda yardımcı olabilir mi?
Oluşturulan e-postadaki imzaya ihtiyacım var:
Bu yorum sitedeki moderatör tarafından en aza indirildi
Sayende şimdi imza ekleyebiliyorum ama daha sonra metnin paragrafları arasındaki boşlukları kaldırıyor. Lütfen bana yardım eder misin?


alt merhabaworld()
OutApp'i Nesne Olarak Karart
OutMail'i Nesne Olarak Karartın
Aralık olarak hücreyi karart
Yolu Dize Olarak Karart
Yol = Application.ActiveWorkbook.Path
Set OutApp = CreateObject("Outlook.Application")

Aralıktaki Her Hücre İçin("C4:C6")
OutMail'i Ayarla = OutApp.CreateItem(0)
OutMail ile
.Görüntüle
.To = hücre.Değer
.Konu = Hücreler(hücre.Satır, "D").Değer
.HTMLBody = "Sevgili " & Cells(cell.Row, "B").Value & "," _
& vbNewLine & vbNewLine & _
"İçten selamlar" _
& vbNewLine & vbNewLine & _
"JK Overseas olarak bizler, 3 yıldır tuz işiyle uğraşan şirketimiz JK Overseas'ı bir fırsat bulup tanıtmak istiyoruz. Şu anda yurtiçinde güçlüyüz ve yurtdışına açılıyoruz. Yemeklik Tuz tedarikçisiyiz, Su Yumuşatma Tuzu, Buz Çözücü Tuz, Endüstriyel Tuz" & "." _
& vbNewLine & vbNewLine & _
"Hindistan'daki büyük ölçekli üreticilerle bağlantımız var ve onlardan kaliteli Tuz ve ihracat sağlıyoruz. Bu nedenle, güvenilir bir uzman ithalatçı ve ayrıca karşılıklı yarar sağlayan uzun vadeli bir İş yapmak için distribütör ajan arıyoruz" & " " _
& vbNewLine & vbNewLine & _
"Gereksinimleriniz veya diğer sorularınız için lütfen bizimle iletişime geçin. Güvenilir lojistik ve zamanında teslimat sağlıyoruz. Fiyatlarımızın en rekabetçi olmasının beklentilerinizi karşılayacağından eminiz" & "." _
& vbNewLine & vbNewLine & _
.HTMLBody

'.Göndermek
İle bitmek
Sonraki hücre
End Sub
Bu yorum sitedeki moderatör tarafından en aza indirildi
Bu kodu, şu anda sahip olduğum mevcut biçime entegre etmeye çalışıyorum, böylece bir dizi değere dayalı olarak excel içindeki e-postaları otomatikleştirebiliyorum. Şu anda sahip olduğum şeyde 'imza' kodunu nereye ekleyeceğime dair herhangi bir yardım çok takdir edilecektir.

Genel Alt CheckAndSendMail()

'Tarafından güncellendi Extendoffice 2018/11/22

xRgDate As Aralığı Dim

Dim xRg Aralık Olarak Gönder

Aralık olarak xRgText Dim

Aralık olarak Dim xRgDone

xOutApp'i Nesne Olarak Karartın

Nesne Olarak xMailItem'i Karartın

xLastRow'u İstediğiniz Kadar Uzunlaştırın

Dize Olarak Dim vbCrLf

Dize olarak xMailBody'yi karart

Dize Olarak xRgDateVal Dim

Dize Olarak Dim xRgSendVal

Dize olarak xMailSubject'i karartın

Dim kadar uzun

On Error Resume Next

'Lütfen son tarih aralığını belirtin

xStrRang = "D2:D110"

xRgDate = Aralık (xStrRang) olarak ayarla

'Lütfen alıcıların e-posta adres aralığını belirtin

xStrRang = "C2:C110"

xRgSend = Aralık(xStrRang) olarak ayarla

xStrRang = "A2:A110"

xRgName = Aralık(xStrRang) olarak ayarla

'E-postanızda hatırlatılan içeriğin bulunduğu aralığı belirtin

xStrRang = "Z2:Z110"

xRgText = Aralık(xStrRang) olarak ayarla

xLastRow = xRgDate.Rows.Count

xRgDate = xRgDate(1) olarak ayarlayın

xRgSend = xRgSend(1) olarak ayarlayın

xRgName = xRgName(1) olarak ayarlayın

xRgText = xRgText(1) olarak ayarlayın

xOutApp = CreateObject("Outlook.Application") olarak ayarlayın

I = 1 için xLastRow için

xRgDateVal = ""

xRgDateVal = xRgDate.Offset(I - 1).Değer

Eğer xRgDateVal <> "" O zaman

Eğer CDate(xRgDateVal) - Tarih <= 30 Ve CDate(xRgDateVal) - Tarih > 0 O zaman

xRgSendVal = xRgSend.Offset(I - 1).Değer

xMailSubject = " JBC Hizmet Sözleşmesinin Süresi Doluyor " & xRgDateVal

vbCrLf = "

"

xMailBody = ""

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

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

xMailBody = xMailBody & ""

xMailItem = xOutApp.CreateItem(0) olarak ayarlayın

xMailItem ile

.Konu = xMailSubject

.To = xRgSendVal

.CC = "mailcc@justbettercare.com"

.HTMLBody = xMailBody

.Görüntüle

'.Göndermek

İle bitmek

xMailItem'i ayarla = Hiçbir şey

Eğer son

Eğer son

Sonraki

xOutApp'ı ayarla = Hiçbir şey

End Sub
Bu yorum sitedeki moderatör tarafından en aza indirildi
Bu gerçekten yararlı bir kod
xOutMsg satırında metin biçimini sağdan sola değiştirmem gerekiyor
yardım lütfen .
Bu yorum sitedeki moderatör tarafından en aza indirildi
Excel'den farklı e-postalara ayrı sayfalar göndermeye çalışıyorum, ancak yalnızca çalışma kitabının kendisini ekleyecek. Ayrıca, imza satırımı ekleyebilmem gerekiyor. Herhangi bir yardım?Sub AST_Email_From_Excel()

E-posta Uygulamasını Nesne Olarak Karart
E-posta Öğesini Nesne Olarak Karart

emailApplication = CreateObject("Outlook.Application") olarak ayarlayın
emailItem = emailApplication.CreateItem(0) olarak ayarlayın

' Şimdi e-postayı oluşturuyoruz.

emailItem.to = Aralık("e2").Değer

emailItem.CC = Aralık("g2").Değer

emailItem.Subject = "İade Edilmeyen Teknik Ekipman"

emailItem.Body = "Bölgenizdeki iade edilmeyen ürünler için ekteki elektronik tabloya bakın"

'Geçerli Çalışma Kitabını Ekle
emailItem.Attachments.ActiveWorkbook.FullName ekleyin

'Bilgisayarınızdaki herhangi bir dosyayı ekleyin.
'emailItem.Attachments.Add ("C:\...)"

'E-postayı gönder
'emailItem.send

'Kullanıcının göndermeden önce istediği gibi değiştirebilmesi için e-postayı görüntüleyin
emailItem.Görüntüle

emailItem = Hiçbir şey ayarla
emailApplication = Hiçbir şey ayarla

End Sub
Bu yorum sitedeki moderatör tarafından en aza indirildi
Merhaba Chris, Sağladığınız kod değiştirildi. Outlook imzası artık ileti gövdesine eklenebilir. Lütfen bir deneyin. Teşekkür ederim. Alt AST_Email_From_Excel()
'Tarafından güncellendi Extendoffice 20220211
E-posta Uygulamasını Nesne Olarak Karart
E-posta Öğesini Nesne Olarak Karart
emailApplication = CreateObject("Outlook.Application") olarak ayarlayın
emailItem = emailApplication.CreateItem(0) olarak ayarlayın

' Şimdi e-postayı oluşturuyoruz.
emailItem.Display 'Kullanıcının göndermeden önce istediği gibi değiştirebilmesi için e-postayı görüntüleyin
emailItem.to = Aralık("e2").Değer
emailItem.CC = Aralık("g2").Değer
emailItem.Subject = "İade Edilmeyen Teknik Ekipman"
emailItem.HTMLBody = "Bölgenizdeki iade edilmeyen ürünler için ekteki elektronik tabloya bakın" & " " & emailItem.HTMLBody

'Geçerli Çalışma Kitabını Ekle
emailItem.Attachments.ActiveWorkbook.FullName ekleyin

emailItem = Hiçbir şey ayarla
emailApplication = Hiçbir şey ayarla

End Sub
Bu yorum sitedeki moderatör tarafından en aza indirildi
Merhaba Crystal,İmzayı eklemesini sağladığın için teşekkürler, HTMLBody bölümünü beğenmemiş gibi görünüyor.Makroyu çalıştırdığımda emailItem.HTMLBody'de hata ayıklıyor = "Bölgenizdeki iade edilmeyen öğeler için ekteki elektronik tabloya bakın" & " " & emailItem.HTMLBodyand gerisini tamamlamaz.  
Bu yorum sitedeki moderatör tarafından en aza indirildi
Merhaba,
Hangi Excel sürümünü kullanıyorsunuz? Aşağıdaki VBA kodu da yardımcı olabilir. Lütfen bir deneyin. Geri bildiriminiz için teşekkürler. Alt SendWorkSheet()
'Güncelleme Extendoffice 20220218
Dize Olarak xFile Dim
xFormat'ı İstediğiniz Uzunlukta Kısın
Çalışma Kitabı Olarak Dim Wb
Çalışma Kitabı Olarak Dim Wb2
FilePath'i Dize Olarak Karartın
Dim DosyaAdı String
OutlookApp'i Nesne Olarak Karartın
OutlookMail'i Nesne Olarak Karartın
On Error Resume Next
Application.ScreenUpdating = Yanlış
Wb'yi Ayarla = Application.ActiveWorkbook
ActiveSheet.Kopya
Wb2 = Application.ActiveWorkbook olarak ayarlayın
Vaka Seç Wb.FileFormat
Vaka xlOpenXMLÇalışma Kitabı:
xFile = ".xlsx"
xFormat = xlOpenXMLÇalışma Kitabı
Case xlOpenXMLWorkbookMacroEnabled:
Eğer Wb2.HasVBProject ise
xFile = ".xlsm"
xFormat = xlOpenXMLÇalışma KitabıMakro Etkin
başka
xFile = ".xlsx"
xFormat = xlOpenXMLÇalışma Kitabı
Eğer son
Örnek Excel8:
xFile = ".xls"
xFormat = Excel8
Vaka xlExcel12:
xFile = ".xlsb"
xFormat = xlExcel12
Select End
FilePath = Environ$("temp") & "\"
DosyaAdı = Çb.Adı ve Biçim(Şimdi, "gg-aa-yy s-aa-ss")
OutlookApp = CreateObject("Outlook.Application") olarak ayarlayın
OutlookMail = OutlookApp.CreateItem(0) olarak ayarlayın
Wb2.SaveAs FilePath & FileName & xFile, FileFormat:=xFormat
'xstr = Aralık("e2") & " ; " & Aralık("g2")
OutlookMail ile
.Görüntüle
.To = Aralık("e2")
.CC = Aralık("g2")
.BCC = ""
.Subject = "İade Edilmeyen Teknik Ekipman"
.HTMLBody = "Bölgenizdeki iade edilmeyen ürünler için ekteki elektronik tabloya bakın" & " " & .HTMLBody
.Ekler.Wb2.FullName Ekle
'.Göndermek
İle bitmek
Wb2.Kapat
FilePath & FileName & xFile'ı öldür
OutlookMail'i Ayarla = Hiçbir Şey
OutlookApp'i Ayarla = Hiçbir Şey
Application.ScreenUpdating = True
End Sub
Bu yorum sitedeki moderatör tarafından en aza indirildi
Excel 2016 ve VBA 7.1 gibi görünüyor
Bu yorum sitedeki moderatör tarafından en aza indirildi
Oi Cristal, bir minha makro perde, bir e-posta yapılandırması ve orijinal biçimi oluşturma. Como consigo çözümleyici?

Alt Geraremail()

Outlook.Application olarak OLapp'ı karartın
Dim janela Outlook.MailItem olarak

OLapp = Yeni Outlook.Application olarak ayarlayın
janela'yı ayarla = OLapp.CreateItem(olMailItem)

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


Janela ile
ActiveWorkbook.Save
.Görüntüle
.To = Sheets("Temel").Range("A2").Value
.CC = Sayfalar("Temel").Range("A5").Value
.Subject = "Mapa - Acrilo" & Format(Tarih, "gg.aa.yy")
assinatura = .vücut
.Body = "Prezados/as," & Chr(10) & Chr(10) & "S&OP vendas previstas olarak Acrilonitrila'nın bir haritasına ekleniyor." & Chr(10) & Chr(10) & assinatura
.Ekler.Anexo01 Ekle
İle bitmek

End Sub
Bu yorum sitedeki moderatör tarafından en aza indirildi
Com a mudança abaixo, consegui ajustar. Times New Roman'dan izin alın. Gostaria de usar Calibri, como posso alterar veya código?

Alt Geraremail()

Outlook.Application olarak OLapp'ı karartın
Dim janela Outlook.MailItem olarak

OLapp = Yeni Outlook.Application olarak ayarlayın
janela'yı ayarla = OLapp.CreateItem(olMailItem)

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


Janela ile
ActiveWorkbook.Save
.Görüntüle
.To = Sheets("Temel").Range("A2").Value
.CC = Sayfalar("Temel").Range("A5").Value
.Subject = "Mapa - Acrilo" & Format(Tarih, "gg.aa.yy")
assinatura = .vücut
.HTMLBody = "Prezados/as," & Chr(10) & Chr(10) & "S&OP'nin vendas previstas olarak Acrilonitrila'nın dikkate alınmasına ilişkin ek açıklama." & " " & .HTMLBody
.Ekler.Anexo01 Ekle
İle bitmek

End Sub
Bu yorum sitedeki moderatör tarafından en aza indirildi
Merhaba Milla,
Aşağıdaki VBA kodu, e-posta gövdesinin yazı tipini Calibri olarak değiştirmenize yardımcı olabilir, lütfen deneyin. Teşekkürler.
Kodu çalıştırmadan önce, tıklamanız gerekir. Tools > Referans içinde Uygulamalar için Microsoft Visual Basic penceresini açın ve ardından Microsoft Word Nesne Kitaplığı onay kutusu Referanslar - VBAProject iletişim kutusu aşağıda gösterilen ekran görüntüsü gibi.
[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
Bu yorum sitedeki moderatör tarafından en aza indirildi
Merhaba Milla,
Aşağıdaki VBA kodu, e-posta gövdesinin yazı tipini Calibri olarak değiştirmenize yardımcı olabilir, lütfen deneyin. Teşekkürler.
Kodu çalıştırmadan önce, tıklamanız gerekir. Tools > Referans içinde Uygulamalar için Microsoft Visual Basic penceresini açın ve ardından Microsoft Word Nesne Kitaplığı onay kutusu Referanslar - VBAProject iletişim kutusu, aşağıda gösterilen ekli dosya olarak.
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
Buraya henüz hiç yorum yapılmamış
Lütfen yorum yazın
Misafir olarak yayınlama
×
Bu gönderiyi değerlendirin:
0   Karakterler
Önerilen Konumlar

Bizi takip et

Telif Hakkı © 2009 - www.extendoffice.com. | Tüm hakları Saklıdır. Tarafından desteklenmektedir ExtendOffice. | | | Site Haritası
Microsoft ve Office logosu, Microsoft Corporation'ın Amerika Birleşik Devletleri ve / veya diğer ülkelerdeki ticari markaları veya tescilli ticari markalarıdır.
Sectigo SSL ile korunmaktadır