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

Bagaimana cara memasukkan tanda tangan Outlook saat mengirim email di Excel?

Misalkan Anda ingin mengirim email langsung di Excel, bagaimana Anda bisa menambahkan tanda tangan Outlook default di email? Artikel ini menyediakan dua metode untuk membantu Anda menambahkan tanda tangan Outlook saat mengirim email di Excel.

Masukkan tanda tangan ke email Outlook saat mengirim dengan Excel VBA
Sisipkan tanda tangan Outlook dengan mudah saat mengirim email di Excel dengan alat yang luar biasa

Tutorial lainnya untuk mengirim email di Excel ...


Masukkan tanda tangan ke email Outlook saat mengirim dengan Excel VBA

Misalnya, ada daftar alamat email di lembar kerja, untuk mengirim email ke semua alamat ini di Excel dan menambahkan tanda tangan Outlook default di email. Silakan terapkan kode VBA di bawah ini untuk mencapainya.

1. Buka lembar kerja yang berisi daftar alamat email yang ingin Anda kirimi email, dan kemudian tekan lain + F11 kunci.

2. Dalam pembukaan Microsoft Visual Basic untuk Aplikasi window, klik Menyisipkan > Modul, lalu salin di bawah ini VBA 2 ke dalam jendela kode Modul.

3. Sekarang Anda perlu mengganti file .Tubuh antri VBA 2 dengan kode masuk VBA 1. Setelah itu, pindahkan garis .Tampilan di bawah garis Dengan xMailOut.

VBA 1: Template pengiriman email dengan tanda tangan default Outlook di Excel

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

VBA 2: Kirim email ke alamat email yang ditentukan dalam sel di Excel

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

Tangkapan layar berikut dapat membantu Anda dengan mudah menemukan perbedaan setelah mengubah kode VBA.

4. tekan F5 kunci untuk menjalankan kode. Kemudian a Kutools untuk Excel pilih kotak yang muncul, pilih alamat email yang akan Anda kirimi email, lalu klik OK.

Kemudian email dibuat. Anda dapat melihat tanda tangan default Outlook ditambahkan di akhir badan email.

Tip:

  • 1. Anda dapat mengubah badan email di kode VBA 1 berdasarkan kebutuhan Anda.
  • 2. Setelah menjalankan kode, jika kotak dialog kesalahan muncul peringatan bahwa jenis yang ditentukan pengguna tidak ditentukan, tutup dialog ini, dan kemudian klik Tools > Referensi dalam Microsoft Visual Basic untuk Aplikasi jendela. Dalam pembukaan Referensi - VBAProject jendela, periksa Perpustakaan Objek Microsoft Outlook kotak dan klik OK. Dan kemudian jalankan kode lagi.

Sisipkan tanda tangan Outlook dengan mudah saat mengirim email di Excel dengan alat yang luar biasa

Jika Anda seorang pemula di VBA, di sini sangat merekomendasikan Mengirim email kegunaan Kutools untuk Excel untukmu. Dengan fitur ini, Anda dapat dengan mudah mengirim email berdasarkan bidang tertentu di Excel dan menambahkan tanda tangan Outlook ke dalamnya. Silakan lakukan sebagai berikut.

Sebelum melamar Kutools untuk Excel, Mohon unduh dan instal terlebih dahulu.

Pertama, Anda perlu membuat milis dengan berbagai bidang yang akan Anda kirimi email.

Anda dapat membuat milis secara manual sesuai kebutuhan atau menerapkan fitur Buat Milis untuk menyelesaikannya dengan cepat.

1. klik Kutools Plus > Buat Milis.

2. Dalam Buat Milis kotak dialog, tentukan bidang yang Anda butuhkan, pilih tempat untuk menampilkan daftar, lalu klik OK .

3. Sekarang contoh milis dibuat. Karena ini adalah daftar sampel, Anda perlu mengubah bidang ke konten tertentu yang dibutuhkan. (beberapa baris diperbolehkan)

4. Setelah itu, pilih seluruh list (include headers), klik Kutools Plus > Mengirim email.

5. Dalam Mengirim email kotak dialog:

  • 5.1) Item di milis yang dipilih ditempatkan di bidang terkait secara otomatis;
  • 5.2) Selesaikan badan email;
  • 5.3) Periksa keduanya Kirim email melalui Outlook serta Gunakan pengaturan tanda tangan Outlook kotak;
  • 5.4) Klik Kirim tombol. Lihat tangkapan layar:

Sekarang email dikirim. Dan tanda tangan Outlook default ditambahkan di akhir badan email.

  Jika Anda ingin memiliki uji coba gratis (

30
-day) dari utilitas ini, silahkan klik untuk mendownloadnya, lalu lanjutkan untuk menerapkan operasi sesuai langkah di atas.

Artikel terkait:

Kirim email ke alamat email yang ditentukan dalam sel di Excel
Misalkan Anda memiliki daftar alamat email, dan Anda ingin mengirim pesan email ke alamat email ini secara massal langsung di Excel. Bagaimana cara mencapainya? Artikel ini akan menunjukkan metode pengiriman email ke beberapa alamat email yang ditentukan dalam sel di Excel.

Kirim email dengan menyalin dan menempelkan rentang tertentu ke badan email di Excel
Dalam banyak kasus, rentang konten tertentu di lembar kerja Excel mungkin berguna dalam komunikasi email Anda. Pada artikel ini, kami akan memperkenalkan metode pengiriman email dengan rentang tertentu yang ditempelkan ke badan email langsung di Excel.

Kirim email dengan beberapa lampiran yang dilampirkan di Excel
Artikel ini membahas tentang mengirim email melalui Outlook dengan beberapa lampiran yang dilampirkan di Excel.

Kirim email jika tanggal jatuh tempo sudah terpenuhi di Excel
Misalnya, jika tanggal jatuh tempo di kolom C kurang dari atau sama dengan 7 hari (tanggal sekarang adalah 2017/9/13), maka kirim pengingat email ke penerima yang ditentukan di kolom A dengan konten yang ditentukan di kolom B.Cara mencapainya? Artikel ini akan memberikan metode VBA untuk mengatasinya secara detail.

Kirim email secara otomatis berdasarkan nilai sel di Excel
Misalkan Anda ingin mengirim email melalui Outlook ke penerima tertentu berdasarkan nilai sel tertentu di Excel. Misalnya, jika nilai sel D7 di lembar kerja lebih besar dari 200, maka email dibuat secara otomatis. Artikel ini memperkenalkan metode VBA bagi Anda untuk menyelesaikan masalah ini dengan cepat.

Tutorial lainnya untuk mengirim email di Excel ...


Alat Produktivitas Kantor Terbaik

Kutools for Excel Memecahkan Sebagian Besar Masalah Anda, dan Meningkatkan Produktivitas Anda hingga 80%

  • Reuse: Masukkan dengan cepat rumus, bagan yang kompleks dan apa pun yang pernah Anda gunakan sebelumnya; Enkripsi Sel dengan kata sandi; Buat Milis dan mengirim email ...
  • Bilah Formula Super (dengan mudah mengedit beberapa baris teks dan rumus); Membaca Tata Letak (membaca dan mengedit sel dalam jumlah besar dengan mudah); Tempel ke Rentang yang Difilter...
  • Gabungkan Sel / Baris / Kolom tanpa kehilangan Data; Pisahkan Konten Sel; Gabungkan Baris / Kolom Duplikat... Mencegah Sel Duplikat; Bandingkan Rentang...
  • Pilih Duplikat atau Unik Baris; Pilih Baris Kosong (semua sel kosong); Temukan Super dan Temukan Fuzzy di Banyak Buku Kerja; Pilih Acak ...
  • Salinan Tepat Beberapa Sel tanpa mengubah referensi rumus; Buat Referensi Otomatis ke Beberapa Lembar; Sisipkan Poin, Kotak Centang, dan lainnya ...
  • Ekstrak Teks, Tambahkan Teks, Hapus berdasarkan Posisi, Hapus Space; Membuat dan Mencetak Subtotal Paging; Konversi Konten Antar Sel dan Komentar...
  • Filter Super (simpan dan terapkan skema filter ke sheet lain); Penyortiran Lanjutan menurut bulan / minggu / hari, frekuensi dan lainnya; Filter Khusus dengan huruf tebal, miring ...
  • Gabungkan Workbooks dan WorkSheets; Gabungkan Tabel berdasarkan kolom kunci; Pisahkan Data menjadi Beberapa Lembar; Konversi Batch xls, xlsx dan PDF...
  • Lebih dari 300 fitur canggih. Mendukung Office / Excel 2007-2021 dan 365. Mendukung semua bahasa. Penerapan yang mudah di perusahaan atau organisasi Anda. Fitur lengkap Uji coba gratis 30 hari. Jaminan uang kembali 60 hari.
tab kte 201905

Tab Office Membawa antarmuka Tab ke Office, dan Membuat Pekerjaan Anda Jauh Lebih Mudah

  • Aktifkan pengeditan dan pembacaan tab di Word, Excel, PowerPoint, Publisher, Access, Visio, dan Project.
  • Buka dan buat banyak dokumen di tab baru di jendela yang sama, bukan di jendela baru.
  • Meningkatkan produktivitas Anda sebesar 50%, dan mengurangi ratusan klik mouse untuk Anda setiap hari!
officetab bawah
Urutkan komentar berdasarkan
komentar (27)
Belum ada peringkat. Jadilah yang pertama memberi peringkat!
Komentar ini diminimalkan oleh moderator di situs
terima kasih banyak, Anda menyelamatkan hidup saya dengan template ini :D
Komentar ini diminimalkan oleh moderator di situs
Favio yang terhormat,
Senang untuk membantu.
Komentar ini diminimalkan oleh moderator di situs
tidak berfungsi dengan lampiran di Office 2016
Komentar ini diminimalkan oleh moderator di situs
Chris terkasih,
Kode VBA di bawah ini dapat membantu Anda. Setelah menjalankan kode, pilih sel yang berisi alamat email yang akan Anda kirimi email, lalu pilih file yang perlu Anda lampirkan di email sebagai lampiran saat kotak dialog kedua muncul. Dan tanda tangan Outlook default akan ditampilkan di badan email juga. Terima kasih atas komentarmu.

Sub SendEmailToAddressInCells()
Redupkan xRg Sebagai Rentang
Redupkan xRgEach Sebagai Rentang
Redupkan xRgVal Sebagai String
Redupkan xAlamat Sebagai String
Redupkan xOutApp Sebagai Outlook.Application
Redupkan xMailOut Sebagai Outlook.MailItem
On Error Resume Next
xAddress = ActiveWindow.RangeSelection.Address
Set xRg = Application.InputBox("Silakan pilih rentang alamat email", "KuTools For Excel", xAddress, , , , , 8)
Jika xRg Bukan Apa-apa Kemudian Keluar Sub
Application.ScreenUpdating = Salah
Setel xOutApp = CreateObject("Outlook.Application")
Tetapkan xRg = xRg.SpecialCells(xlCellTypeConstants, xlTextValues)
Setel xFileDlg = Application.FileDialog(msoFileDialogFilePicker)
Jika xFileDlg.Show = -1 Maka
Untuk Setiap xRgEach Dalam xRg
xRgVal = xRgEach.Nilai
Jika xRgVal Suka "?*@?*.?*" Lalu
Setel xMailOut = xOutApp.CreateItem(olMailItem)
Dengan xMailOut
.Tampilan
.Ke = xRgVal
.Subjek = "Tes"
.HTMLBody = "Ini adalah tes pengiriman email di Excel" & "
" & .HTMLBody
Untuk Setiap xFileDlgItem Di xFileDlg.SelectedItems
.Lampiran.Tambahkan xFileDlgItem
xFileDlgItem berikutnya
'.Kirim
Berakhir dengan
End If
Next
Setel xMailOut = Tidak Ada
Setel xOutApp = Tidak Ada
Application.ScreenUpdating = Benar
End If
End Sub
Komentar ini diminimalkan oleh moderator di situs
saya mencoba menambahkan tanda tangan pandangan berjudul "default" tetapi sepertinya tidak berfungsi.
bisa tolong bantu? Saya percaya bahwa logika "xMailout" saya salah. ini adalah daerah saya yang diduga rusak.

Sub CommandButton1_Click Pribadi ()

Redupkan xOutApp Sebagai Objek
Redupkan xOutMail Sebagai Objek
Redupkan xMailBody Sebagai String
Redupkan xMailOut Sebagai Outlook.MailItem
On Error Resume Next
Setel xOutApp = CreateObject("Outlook.Application")
Setel xOutMail = xOutApp.CreateItem(0)
xMailBody = "Salam:" & vbNewLine & vbNewLine & _
"Ini adalah baris 1" & vbNewLine & _
"Ini adalah baris 2" & vbNewLine & _
"Ini adalah baris 3" & vbNewLine & _
"Ini baris 4"
On Error Resume Next
Dengan xOutMail
.Ke = "Email.di sini.com"
.CC = "Email.disini.com"
.Subjek = "Judul Email Di Sini - " & Range("Sel#").value
.Body = xMailBody
. Lampiran.Tambahkan ActiveWorkbook.Nama Lengkap
Setel xMailOut = xOutApp.CreateItem(olMailItem)
Dengan xMailOut
.Tampilan
Berakhir dengan
ActiveWorkbook.Simpan
Pada Kesalahan GoTo 0
Setel xOutMail = Tidak Ada
Setel xOutApp = Tidak Ada
End Sub
Komentar ini diminimalkan oleh moderator di situs
Hari baik,
Skrip Anda telah dimodifikasi, silakan coba. Terima kasih.

Sub CommandButton1_Click Pribadi ()
Redupkan xOutApp Sebagai Objek
Redupkan xOutMail Sebagai Objek
Redupkan xMailBody Sebagai String
Redupkan xMailOut Sebagai Outlook.MailItem
On Error Resume Next
Setel xOutApp = CreateObject("Outlook.Application")
Setel xOutMail = xOutApp.CreateItem(0)
xMailBody = "Salam:" & vbNewLine & vbNewLine & _
"Ini adalah baris 1" & vbNewLine & _
"Ini adalah baris 2" & vbNewLine & _
"Ini adalah baris 3" & vbNewLine & _
"Ini baris 4"
On Error Resume Next
Dengan xOutMail
.Ke = "Email.di sini.com"
.CC = "Email.disini.com"
.Subjek = "Judul Email Di Sini - " & Rentang("Sel#").Nilai
.Body = xMailBody
.Attachments.Add ActiveWorkbook.FullName
Setel xMailOut = xOutApp.CreateItem(olMailItem)
Dengan xMailOut
.Tampilan
Berakhir dengan
Berakhir dengan
ActiveWorkbook.Simpan
Pada Kesalahan GoTo 0
Setel xOutMail = Tidak Ada
Setel xOutApp = Tidak Ada
End Sub
Komentar ini diminimalkan oleh moderator di situs
cara menambahkan tanda tangan jika makro digunakan oleh banyak pengguna.
misalnya makro saya akan dijalankan oleh 3 orang lain juga. Jadi bagaimana makro bisa menggunakan tanda tangan pengguna yang menjalankan makro.
terima kasih sebelumnya
Komentar ini diminimalkan oleh moderator di situs
Selamat siang,
Kode VBA dapat secara otomatis mengenali tanda tangan default di Outlook pengirim, dan mengirim email dengan tanda tangannya sendiri melalui Outlook.
Komentar ini diminimalkan oleh moderator di situs
Jika teks tubuh saya ditautkan untuk menarik dari bidang excel, penggunaan & .HTMLBody di akhir string menghapus semua teks isi dan hanya meninggalkan tanda tangan.
Komentar ini diminimalkan oleh moderator di situs
Saya mengalami masalah saat menjalankan ini di excel 2016. Saya mendapatkan pesan "Kesalahan Kompilasi: Jenis yang Ditentukan Pengguna Tidak Ditentukan". Tolong bantu!
Komentar ini diminimalkan oleh moderator di situs
Hebat!!!!
Komentar ini diminimalkan oleh moderator di situs
Terima kasih banyak...
Komentar ini diminimalkan oleh moderator di situs
Hai, saya perlu bantuan dengan makro saya, saya perlu memasukkan tanda tangan Outlook di bawah tabel, dapatkah Anda membantu saya dengan itu?

Sub CommandButton1_Click Pribadi ()


Pandangan redup Sebagai Obyek
Redupkan Email baru Sebagai Objek
Redupkan xPeriksa Sebagai Objek
Redupkan halamanEditor Sebagai Obyek

Setel pandangan = CreateObject("Outlook.Application")
Setel email baru = outlook.CreateItem(0)

Dengan email baru
.Ke = Sheet5.Range("F1")
.CC = ""
.BCC = ""
.Subjek = Sheet5.Range("B5")
.Body = Sheet5.Range("B41")
.menampilkan

Setel xInspect = newEmail.GetInspector
Setel pageEditor = xInspect.WordEditor

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

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

.menampilkan
Setel halamanEditor = Tidak ada
Tetapkan xInspect = Tidak Ada
Berakhir dengan

Setel email baru = Tidak ada
Tetapkan pandangan = Tidak ada

End Sub
Komentar ini diminimalkan oleh moderator di situs
Hai Bara,
Maaf tidak dapat membantu Anda dengan itu. Terima kasih atas komentar Anda.
Komentar ini diminimalkan oleh moderator di situs
Sayang,
Dapatkah seseorang membantu saya dengan VBA saya,
Saya perlu tanda tangan di email yang dibuat:
Komentar ini diminimalkan oleh moderator di situs
Terima kasih kepada Anda, saya dapat menambahkan tanda tangan sekarang tetapi kemudian menghilangkan spasi di antara paragraf teks. Tolong Bisakah Anda Membantu saya?


Sub halo dunia()
Redupkan OutApp Sebagai Objek
Redupkan OutMail Sebagai Objek
Sel redup Sebagai Rentang
Jalur Redup Sebagai String
Path = Application.ActiveWorkbook.Path
Atur OutApp = CreateObject("Outlook.Application")

Untuk Setiap sel Dalam Rentang("C4:C6")
Atur OutMail = OutApp.CreateItem(0)
Dengan OutMail
.Tampilan
.Ke = sel.Nilai
.Subjek = Sel(sel.Baris, "D").Nilai
.HTMLBody = "Yang Terhormat " & Sel(sel.Baris, "B").Nilai & "," _
& vbNewLine & vbNewLine & _
"Salam Hangat" _
& vbNewLine & vbNewLine & _
“Kami JK Overseas ingin mengambil kesempatan dan memperkenalkan perusahaan kami JK Overseas, yang bergerak di bisnis garam selama 3 tahun terakhir. Saat ini kami kuat di dalam negeri dan berkembang di luar negeri. Kami adalah pemasok Garam Makan, Garam Pelunakan Air, Garam De-icing, Garam Industri" & "." _
& vbNewLine & vbNewLine & _
"Kami memiliki ikatan dengan produsen skala besar di India dan mendapatkan dari mereka Garam berkualitas dan ekspor. Jadi, kami mencari importir ahli yang andal serta agen distributor untuk membuat Bisnis jangka panjang dengan saling menguntungkan" & " ." _
& vbNewLine & vbNewLine & _
"Silakan hubungi kami dengan kebutuhan Anda atau untuk pertanyaan lain yang mungkin Anda miliki. Kami menyediakan logistik yang andal dan pengiriman tepat waktu. Kami yakin bahwa harga kami yang paling kompetitif akan sesuai dengan harapan Anda" & "." _
& vbNewLine & vbNewLine & _
.HTMLTubuh

'.Kirim
Berakhir dengan
sel berikutnya
End Sub
Komentar ini diminimalkan oleh moderator di situs
Saya mencoba mengintegrasikan kode ini ke dalam format saat ini yang saya miliki saat ini di mana saya dapat mengotomatiskan email dalam excel berdasarkan rentang nilai yang ditetapkan. Bantuan apa pun sehubungan dengan tempat menambahkan kode 'tanda tangan' dalam apa yang saya miliki saat ini akan sangat dihargai.

Sub Publik CheckAndSendMail()

'Diperbaharui oleh Extendoffice 2018 / 11 / 22

Redupkan xRgDate Sebagai Rentang

Redupkan xRgKirim Sebagai Rentang

Redupkan xRgText Sebagai Rentang

Redupkan xRgSelesai Sebagai Rentang

Redupkan xOutApp Sebagai Objek

Redupkan xMailItem Sebagai Objek

Redupkan xLastRow Selamanya

Redupkan vbCrLf Sebagai String

Redupkan xMailBody Sebagai String

Redupkan xRgDateVal Sebagai String

Redupkan xRgSendVal Sebagai String

Redupkan xMailSubject Sebagai String

Redup Aku Selamanya

On Error Resume Next

'Silakan tentukan rentang tanggal jatuh tempo

xStrRang = "D2:D110"

Setel xRgDate = Rentang (xStrRang)

'Harap tentukan rentang alamat email penerima

xStrRang = "C2:C110"

Tetapkan xRgSend = Rentang (xStrRang)

xStrRang = "A2:A110"

Setel xRgName = Rentang (xStrRang)

'Tentukan rentang dengan konten yang diingatkan di email Anda

xStrRang = "Z2:Z110"

Setel xRgText = Rentang (xStrRang)

xLastRow = xRgDate.Rows.Count

Setel xRgDate = xRgDate(1)

Tetapkan xRgSend = xRgSend(1)

Setel xRgName = xRgName(1)

Setel xRgText = xRgText(1)

Setel xOutApp = CreateObject("Outlook.Application")

Untuk I = 1 Ke xLastRow

xRgDateVal = ""

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

Jika xRgDateVal <> "" Maka

Jika CDate(xRgDateVal) - Tanggal <= 30 Dan CDate(xRgDateVal) - Tanggal > 0 Kemudian

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

xMailSubject = " Perjanjian Layanan JBC Berakhir Pada " & xRgDateVal

vbCrLf = "

"

xMailBody = ""

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

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

xMailBody = xMailBody & ""

Setel xMailItem = xOutApp.CreateItem(0)

Dengan xMailItem

.Subjek = xMailSubjek

.Ke = xRgSendVal

.CC = "mailcc@justbettercare.com"

.HTMLBody = xMailBody

.Tampilan

'.Kirim

Berakhir dengan

Setel xMailItem = Tidak Ada

End If

End If

Next

Setel xOutApp = Tidak Ada

End Sub
Komentar ini diminimalkan oleh moderator di situs
Ini kode yang sangat membantu
Saya perlu mengubah format teks dari kanan ke kiri Di baris xOutMsg
tolonglah .
Komentar ini diminimalkan oleh moderator di situs
Saya mencoba mengirim lembar individual dari excel ke email yang berbeda, tetapi itu hanya akan melampirkan buku kerja itu sendiri. Juga, harus dapat menambahkan baris tanda tangan saya. Ada bantuan?Sub AST_Email_From_Excel()

Redup emailAplikasi Sebagai Obyek
Redupkan emailItem Sebagai Objek

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

' Sekarang kita membangun email.

emailItem.to = Range("e2").Nilai

emailItem.CC = Range("g2").Nilai

emailItem.Subject = "Peralatan Teknis yang Tidak Dikembalikan"

emailItem.Body = "Lihat spreadsheet terlampir untuk item yang belum dikembalikan di wilayah Anda"

'Lampirkan Buku Kerja saat ini
emailItem.Attachments.Add ActiveWorkbook.FullName

'Lampirkan file apa pun dari komputer Anda.
'emailItem.Attachments.Add ("C:\...)"

'Kirim email
'emailItem.send

'Tampilkan email sehingga pengguna dapat mengubahnya sesuai keinginan sebelum mengirim
emailItem.Tampilan

Setel emailItem = Tidak ada
Setel emailApplication = Tidak ada

End Sub
Komentar ini diminimalkan oleh moderator di situs
Hai Chris, Kode yang Anda berikan telah dimodifikasi. Tanda tangan Outlook sekarang dapat dimasukkan ke dalam isi pesan. Ayo cobalah. Terima kasih. Sub AST_Email_From_Excel()
'Diperbaharui oleh Extendoffice 20220211
Redup emailAplikasi Sebagai Obyek
Redupkan emailItem Sebagai Objek
Setel emailApplication = CreateObject("Outlook.Application")
Setel emailItem = emailApplication.CreateItem(0)

' Sekarang kita membangun email.
emailItem.Display 'Menampilkan email sehingga pengguna dapat mengubahnya sesuai keinginan sebelum mengirim
emailItem.to = Range("e2").Nilai
emailItem.CC = Range("g2").Nilai
emailItem.Subject = "Peralatan Teknis yang Tidak Dikembalikan"
emailItem.HTMLBody = "Lihat spreadsheet terlampir untuk item yang belum dikembalikan di wilayah Anda" & " " & emailItem.HTMLBody

'Lampirkan Buku Kerja saat ini
emailItem.Attachments.Add ActiveWorkbook.FullName

Setel emailItem = Tidak ada
Setel emailApplication = Tidak ada

End Sub
Komentar ini diminimalkan oleh moderator di situs
Hai Crystal, Terima kasih telah memintanya untuk menambahkan tanda tangan, tampaknya tidak menyukai bagian HTMLBody. Ketika saya menjalankan makro, makro itu di-debug di emailItem.HTMLBody = "Lihat spreadsheet terlampir untuk item yang tidak dikembalikan di area Anda" & " " & emailItem.HTMLBodyand tidak menyelesaikan sisanya.  
Komentar ini diminimalkan oleh moderator di situs
Hai,
Versi Excel mana yang Anda gunakan? Kode VBA berikut juga dapat membantu. Ayo cobalah. Terima kasih atas tanggapan Anda. Sub SendWorkSheet()
'Perbarui oleh Extendoffice 20220218
Redupkan xFile Sebagai String
Redupkan xFormat Selamanya
Redupkan Wb Sebagai Buku Kerja
Redupkan Wb2 Sebagai Buku Kerja
Redupkan FilePath Sebagai String
Redupkan Nama File Sebagai String
Redupkan OutlookApp Sebagai Objek
Redupkan OutlookMail Sebagai Objek
On Error Resume Next
Application.ScreenUpdating = Salah
Setel Wb = Application.ActiveWorkbook
Lembar Aktif.Salin
Setel Wb2 = Application.ActiveWorkbook
Pilih Kasus Wb.FileFormat
Kasus xlBukaXMLBuku kerja:
xFile = ".xlsx"
xFormat = xlOpenXMLWorkbook
Kasus xlOpenXMLWorkbookMacroDiaktifkan:
Jika Wb2.Memiliki VBProject Kemudian
xFile = ".xlsm"
xFormat = xlOpenXMLWorkbookMacroEnabled
Lain
xFile = ".xlsx"
xFormat = xlOpenXMLWorkbook
End If
Kasus Excel8:
xFile = ".xls"
xFormat = Excel8
Kasus xlExcel12:
xFile = ".xlsb"
xFormat = xlExcel12
End Select
FilePath = Environ$("temp") & "\"
FileName = Wb.Name & Format(Sekarang, "dd-mmm-yy h-mm-ss")
Setel OutlookApp = CreateObject("Outlook.Application")
Setel OutlookMail = OutlookApp.CreateItem(0)
Wb2.SaveAs FilePath & FileName & xFile, FileFormat:=xFormat
'xstr = Rentang("e2") & " ; " & Rentang("g2")
Dengan OutlookMail
.Tampilan
.Ke = Rentang("e2")
.CC = Rentang("g2")
.BCC = ""
.Subjek = "Peralatan Teknis yang Tidak Dikembalikan"
.HTMLBody = "Lihat spreadsheet terlampir untuk item yang belum dikembalikan di wilayah Anda" & " " & .HTMLBody
.Lampiran.Tambahkan Wb2.Nama Lengkap
'.Kirim
Berakhir dengan
Wb2.Tutup
Bunuh FilePath & FileName & xFile
Setel OutlookMail = Tidak Ada
Setel OutlookApp = Tidak Ada
Application.ScreenUpdating = Benar
End Sub
Komentar ini diminimalkan oleh moderator di situs
Sepertinya Excel 2016 dan VBA 7.1
Komentar ini diminimalkan oleh moderator di situs
Oi Cristal, a minha makro perde a configuração da assinatura do e-mail, com imagens dan formatação original. Penyelesai konsigo como?

Sub Gerarmail()

Redupkan OLapp Sebagai Outlook.Aplikasi
Redupkan janela Sebagai Outlook.MailItem

Setel OLapp = Outlook.Application Baru
Setel janela = OLapp.CreateItem(olMailItem)

Arquivo01 = "Peta AN"
Anexo01 = Buku Kerja Ini.Path & "\" & Arquivo01 & ".xlsm"


Dengan janela
ActiveWorkbook.Simpan
.Tampilan
.Untuk = Sheets("Base").Range("A2").Value
.CC = Sheets("Base").Range("A5").Value
.Subjek = "Mapa - Acrilo " & Format(Tanggal, "dd.mm.yy")
assinatura = .Tubuh
.Body = "Prezados/as," & Chr(10) & Chr(10) & "Segue anexo o mapa de Acrilonitrila pertimbangkan dan pertimbangkan sebagai vendas previstas no S&OP." & Chr(10) & Chr(10) & assinatura
.Lampiran.Tambahkan Anexo01
Berakhir dengan

End Sub
Komentar ini diminimalkan oleh moderator di situs
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 atau codigo?

Sub Gerarmail()

Redupkan OLapp Sebagai Outlook.Aplikasi
Redupkan janela Sebagai Outlook.MailItem

Setel OLapp = Outlook.Application Baru
Setel janela = OLapp.CreateItem(olMailItem)

Arquivo01 = "Peta AN"
Anexo01 = Buku Kerja Ini.Path & "\" & Arquivo01 & ".xlsm"


Dengan janela
ActiveWorkbook.Simpan
.Tampilan
.Untuk = Sheets("Base").Range("A2").Value
.CC = Sheets("Base").Range("A5").Value
.Subjek = "Mapa - Acrilo " & Format(Tanggal, "dd.mm.yy")
assinatura = .Tubuh
.HTMLBody = "Prezados/as," & Chr(10) & Chr(10) & "Segue anxo o mapa de Acrilonitrila pertimbangkan sebagai vendas previstas no S&OP." & " " & .HTMLBody
.Lampiran.Tambahkan Anexo01
Berakhir dengan

End Sub
Komentar ini diminimalkan oleh moderator di situs
Hai Milla,
Kode VBA berikut dapat membantu Anda mengubah font badan email menjadi Calibri, silakan mencobanya. Terima kasih.
Sebelum menjalankan kode, Anda perlu mengklik Tools > Referensi dalam Microsoft Visual Basic untuk Aplikasi jendela, lalu centang Perpustakaan objek Microsoft Word kotak centang di Referensi - Proyek VBA kotak dialog seperti gambar di bawah ini.
[img]Saya:\工作\周雪明\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
Komentar ini diminimalkan oleh moderator di situs
Hai Milla,
Kode VBA berikut dapat membantu Anda mengubah font badan email menjadi Calibri, silakan mencobanya. Terima kasih.
Sebelum menjalankan kode, Anda perlu mengklik Tools > Referensi dalam Microsoft Visual Basic untuk Aplikasi jendela, lalu centang Perpustakaan objek Microsoft Word kotak centang di Referensi - Proyek VBA kotak dialog seperti file terlampir yang ditunjukkan di bawah ini.
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
Belum ada komentar yang diposting di sini
Tinggalkan komentar anda
Posting sebagai Tamu
×
Beri peringkat pos ini:
0   Karakter
Lokasi yang Disarankan

Ikuti kami

Hak Cipta © 2009 - www.extendoffice.com. | Seluruh hak cipta. Dipersembahkan oleh ExtendOffice. | Peta Situs
Microsoft dan logo Office adalah merek dagang atau merek dagang terdaftar dari Microsoft Corporation di Amerika Serikat dan / atau negara lain.
Dilindungi oleh Sectigo SSL