Jak wstawić podpis programu Outlook podczas wysyłania wiadomości e-mail w programie Excel?

Przypuśćmy, że chcesz wysłać wiadomość e-mail bezpośrednio w programie Excel, jak dodać domyślny podpis programu Outlook w wiadomości e-mail? W tym artykule przedstawiono dwie metody ułatwiające dodawanie podpisu programu Outlook podczas wysyłania wiadomości e-mail w programie Excel.

Wstaw podpis do wiadomości e-mail programu Outlook podczas wysyłania przez Excel VBA
Z łatwością wstaw podpis programu Outlook podczas wysyłania wiadomości e-mail w programie Excel za pomocą niesamowitego narzędzia
Więcej samouczków dotyczących wysyłania wiadomości w programie Excel ...

Wstaw podpis do wiadomości e-mail programu Outlook podczas wysyłania przez Excel VBA

Na przykład w arkuszu znajduje się lista adresów e-mail, aby wysyłać wiadomości e-mail na wszystkie te adresy w programie Excel i dodawać domyślny podpis programu Outlook w wiadomościach e-mail. Aby to osiągnąć, zastosuj poniższy kod VBA.

1. Otwórz arkusz zawierający listę adresów e-mail, do których chcesz wysłać wiadomość e-mail, a następnie naciśnij inny + F11 klawiatura.

2. W otwarciu Microsoft Visual Basic for Applications okno, kliknij wstawka > Moduł, a następnie skopiuj poniższe VBA2 do okna kodu modułu.

3. Teraz musisz wymienić .Ciało wyrysować VBA2 z kodem w formacie VBA1. Następnie przesuń linię .Pokaz pod linią Dzięki xMailOut.

VBA 1: Szablon wysyłania wiadomości e-mail z domyślnym podpisem programu Outlook w programie Excel

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

VBA 2: wysyłanie wiadomości e-mail na adresy e-mail określone w komórkach w programie 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

Poniższy zrzut ekranu może pomóc w łatwym znalezieniu różnic po zmianie kodu VBA.

4. wciśnij F5 klucz do uruchomienia kodu. Następnie Kutools dla programu Excel wybierz okienko wyskakujące, wybierz adresy e-mail, na które będziesz wysyłać wiadomości, a następnie kliknij OK.

Następnie tworzone są e-maile. Możesz zobaczyć, że domyślny podpis programu Outlook jest dodawany na końcu treści wiadomości e-mail.

Porady:

1. Możesz zmienić treść wiadomości e-mail w kodzie VBA 1 w zależności od potrzeb.
2. Po uruchomieniu kodu, jeśli pojawi się okno dialogowe błędu z ostrzeżeniem, że typ zdefiniowany przez użytkownika nie jest zdefiniowany, zamknij to okno, a następnie kliknij Tools > Referencje Microsoft Visual Basic for Applications okno. W otwarciu Referencje - VBAProject okno, sprawdź Biblioteka obiektów programu Microsoft Outlook i kliknij OK. Następnie ponownie uruchom kod.

Z łatwością wstaw podpis programu Outlook podczas wysyłania wiadomości e-mail w programie Excel za pomocą niesamowitego narzędzia

Jeśli jesteś nowicjuszem w VBA, tutaj bardzo polecam Wysyłać emaile użyteczność Kutools dla programu Excel dla Was. Dzięki tej funkcji możesz łatwo wysyłać wiadomości e-mail na podstawie określonych pól w programie Excel i dodawać do nich podpis programu Outlook. Wykonaj następujące czynności.

Przed złożeniem wniosku Kutools dla programu ExcelProszę pobierz i zainstaluj najpierw.

Po pierwsze, musisz utworzyć listę mailingową z różnymi polami, na podstawie których będziesz wysyłać e-maile.

Możesz ręcznie utworzyć listę mailingową według potrzeb lub zastosować funkcję Utwórz listę mailingową, aby szybko to zrobić.

1. kliknij Kutools Plus > Utwórz listę mailingową.

2. w Utwórz listę mailingową W oknie dialogowym określ potrzebne pola, wybierz miejsce, w którym chcesz wyprowadzić listę, a następnie kliknij OK przycisk.

3. Teraz tworzona jest próbka listy mailingowej. Ponieważ jest to lista przykładowa, musisz zmienić pola na określoną potrzebną zawartość. (dozwolone jest wiele wierszy)

4. Następnie zaznacz całą listę (wraz z nagłówkami), kliknij Kutools Plus > Wysyłać emaile.

5. w Wysyłać emaile Okno dialogowe:

5.1) Pozycje z wybranej listy mailingowej są automatycznie umieszczane w odpowiednich polach;
5.2) Zakończ treść wiadomości e-mail;
5.3) Sprawdź oba pliki Wyślij e-mail przez Outlooka i Użyj ustawień podpisu programu Outlook pudła;
5.4) Kliknij Wyślij przycisk. Zobacz zrzut ekranu:

Teraz e-maile są wysyłane. A domyślny podpis programu Outlook jest dodawany na końcu treści wiadomości e-mail.

Jeśli chcesz mieć bezpłatną wersję próbną (30 dni) tego narzędzia, kliknij, aby go pobrać, a następnie przejdź do wykonania operacji zgodnie z powyższymi krokami.

Podobne artykuły:

Wyślij wiadomość e-mail na adresy e-mail określone w komórkach w programie Excel
Przypuśćmy, że masz listę adresów e-mail i chcesz wysłać zbiorczo wiadomość e-mail na te adresy e-mail bezpośrednio w programie Excel. Jak to osiągnąć? W tym artykule pokażemy metody wysyłania wiadomości e-mail na wiele adresów e-mail określonych w komórkach w programie Excel.

Wyślij wiadomość e-mail z kopiowaniem i wklejaniem określonego zakresu do treści wiadomości e-mail w programie Excel
W wielu przypadkach określony zakres treści w arkuszu programu Excel może być przydatny w komunikacji e-mailowej. W tym artykule przedstawimy metodę wysyłania wiadomości e-mail z wklejaniem określonego zakresu do treści wiadomości bezpośrednio w programie Excel.

Wyślij wiadomość e-mail z wieloma załącznikami w programie Excel
W tym artykule mowa o wysyłaniu wiadomości e-mail za pośrednictwem programu Outlook z wieloma załącznikami w programie Excel.

Wyślij e-mail, jeśli termin został osiągnięty w programie Excel
Na przykład, jeśli termin w kolumnie C jest mniejszy lub równy 7 dni (aktualna data to 2017/9/13), wyślij e-mail z przypomnieniem do określonego odbiorcy w kolumnie A z określoną zawartością w kolumnie B. Jak Osiągnij to? W tym artykule szczegółowo omówimy metodę VBA.

Automatycznie wysyłaj wiadomości e-mail na podstawie wartości komórki w programie Excel
Przypuśćmy, że chcesz wysłać wiadomość e-mail za pośrednictwem programu Outlook do określonego odbiorcy na podstawie określonej wartości komórki w programie Excel. Na przykład, jeśli wartość komórki D7 w arkuszu jest większa niż 200, wiadomość e-mail jest tworzona automatycznie. W tym artykule przedstawiono metodę VBA umożliwiającą szybkie rozwiązanie tego problemu.

Więcej samouczków dotyczących wysyłania wiadomości w programie Excel ...

Najlepsze narzędzia biurowe

🤖	Pomocnik AI Kutools: Zrewolucjonizuj analizę danych w oparciu o: Inteligentne wykonanie \| Wygeneruj kod \| Twórz niestandardowe formuły \| Analizuj dane i generuj wykresy \| Wywołaj funkcje Kutools...
	Popularne funkcje: Znajdź, wyróżnij lub zidentyfikuj duplikaty \| Usuń puste wiersze \| Łącz kolumny lub komórki bez utraty danych \| Okrągły bez wzoru ...
	Super wyszukiwanie: Wiele kryteriów VLookup \| Wiele wartości VLookup \| Przeglądanie pionowe na wielu arkuszach \| Wyszukiwanie rozmyte ....
	Zaawansowana lista rozwijana: Szybko twórz listę rozwijaną \| Zależna lista rozwijana \| Lista rozwijana wielokrotnego wyboru ....
	Menedżer kolumn: Dodaj określoną liczbę kolumn \| Przesuń kolumny \| Przełącz stan widoczności ukrytych kolumn \| Porównaj zakresy i kolumny ...
	Polecane funkcje: Fokus siatki \| Widok projektu \| Duży pasek formuły \| Menedżer skoroszytów i arkuszy \| Biblioteka zasobów (Automatyczny tekst) \| Selektor dat \| Połącz arkusze \| Szyfruj/odszyfruj komórki \| Wysyłaj e-maile według listy \| Super filtr \| Specjalny filtr (filtruj pogrubienie/kursywa/przekreślenie...) ...
	15 najlepszych zestawów narzędzi: 12 Tekst Tools (Dodaj tekst, Usuń znaki, ...) \| 50 + Wykres rodzaje (Wykres Gantta, ...) \| 40+ Praktyczne Wzory (Oblicz wiek na podstawie urodzin, ...) \| 19 Wprowadzenie Tools (Wstaw kod QR, Wstaw obraz ze ścieżki, ...) \| 12 Konwersja Tools (Liczby na słowa, Przeliczanie walut, ...) \| 7 Połącz i podziel Tools (Zaawansowane wiersze łączenia, Podział komórki, ...) \| ... i więcej

Zwiększ swoje umiejętności Excela dzięki Kutools for Excel i doświadcz wydajności jak nigdy dotąd. Kutools dla programu Excel oferuje ponad 300 zaawansowanych funkcji zwiększających produktywność i oszczędzających czas. Kliknij tutaj, aby uzyskać funkcję, której najbardziej potrzebujesz...

Opis

Czytaj więcej... Darmowe pobieranie...

Karta Office wprowadza interfejs z zakładkami do pakietu Office i znacznie ułatwia pracę

Włącz edycję i czytanie na kartach w programach Word, Excel, PowerPoint, Publisher, Access, Visio i Project.
Otwieraj i twórz wiele dokumentów w nowych kartach tego samego okna, a nie w nowych oknach.
Zwiększa produktywność o 50% i redukuje setki kliknięć myszką każdego dnia!

Czytaj więcej... Darmowe pobieranie...

Comments (31)

No ratings yet. Be the first to rate!

Raaj Mehta

about 8 months ago

#43484

This comment was minimized by the moderator on the site

Greetings,

How do i add signature in Email body?

Sub outlook165050()
'
' Send 165050 mail
'
Dim xMailBody As String

'
'Application.Dialogs(xlDialogSendMail).Show
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)

With OutMail
.To = " ; ; "
.CC = " ; ; "
.BCC = ""
.Subject = "165050 Swap VM Movements " & Date
.Body = "Todays VM for 165050 is $0"

.Display
'.Send
End With
End Sub

crystal Raaj Mehta

about 8 months ago

#43526

This comment was minimized by the moderator on the site

Hi Raaj Mehta,

You VBA code has been modified. Please give it a try.

Sub outlook165050()
'
' Send 165050 mail
'
Dim xMailBody As String

'
'Application.Dialogs(xlDialogSendMail).Show
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)

With OutMail
.Display
.To = " ;  ; "
.CC = " ;  ; "
.BCC = ""
.Subject = "165050 Swap VM Movements " & Date
.HTMLBody = "Todays VM for 165050 is $0" & "<br>" & .HTMLBody

'.Send
End With
End Sub

Report

Roseanne

about 1 year ago

#42926

This comment was minimized by the moderator on the site

Hello, I am trying to fix my VBA Code. I would like to include one of my outlook signatures with a logo. Is this possible, and where do I put the code that I am currently using? Any assistance would be great.

Sub EmailAspdf()

Dim EApp As Object
Set EApp = CreateObject("Outlook.Application")

Dim EItem As Object
Set EItem = EApp.CreateItem(0)

Dim invno As Long
Dim custname As String
Dim amt As Currency
Dim dt_issue As Date
Dim term As Byte
Dim nextrec As Range
Dim path As String
Dim fname As String

invno = Range("I4")
custname = Range("A11")
amt = Range("I42")
dt_issue = Range("I6")
term = Range("I7")
path = "mypath"
fname = invno & " - " & custname

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

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

nextrec = invno
nextrec.Offset(0, 1) = custname
nextrec.Offset(0, 2) = amt
nextrec.Offset(0, 3) = dt_issue
nextrec.Offset(0, 4) = dt_issue + term
nextrec.Offset(0, 8) = Now

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

With EItem

.To = Range("A17")

.Subject = Range("A11") & " " & "Invoice No: " & Range("I4") & " " & "for California Advocates"

.body = "Hello " & Range("A11") & "," & vbNewLine & vbNewLine _
& "Please see the attached invoice for " & Range("A11") & "." & vbNewLine & vbNewLine _
& "If you have any questions, please do not hesitate to contact me." & vbNewLine & vbNewLine _
& "Best," & vbNewLine _
& "Mynamehere" & vbNewLine

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

.Display

End With
Exit Sub

End Sub

crystal Roseanne

about 1 year ago

#43001

This comment was minimized by the moderator on the site

Hi RoseAnne,

You can manually add the logo to your signature in advance before applying the VBA code. The code needs to be put in the Module code window (press the Alt + F11 to open the Visual Basic Editor, click Insert > Module)

Report

Milla

about 1 year ago

#38513

This comment was minimized by the moderator on the site

Oi Cristal, a minha macro perde a configuração da assinatura do e-mail, com imagens e formatação original. Como consigo resolver?

Sub Geraremail()

Dim OLapp As Outlook.Application
Dim janela As Outlook.MailItem

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
.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
.Attachments.Add Anexo01
End With

End Sub

Milla Milla

about 1 year ago

#38514

This comment was minimized by the moderator on the site

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()

Dim OLapp As Outlook.Application
Dim janela As Outlook.MailItem

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

End Sub

crystal Milla

about 1 year ago

#38530

This comment was minimized by the moderator on the site

Hi Milla,
The following VBA code can help you change the font of email body to Calibri, please give it a try. Thank you.
Before running the code, you need to click Tools > Reference in the Microsoft Visual Basic for Applications window, and then check the Microsoft Word Object Library checkbox in the References - VBAProject dialog box as the attached file shown below.

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

View Attachments (1 / 5)

Report

crystal Milla

about 1 year ago

#38528

This comment was minimized by the moderator on the site

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

View Attachments (1 / 5)

Report

Chris

about 2 years ago

#37369

This comment was minimized by the moderator on the site

I'm trying to send individual sheets from excel to different emails, but it will only attach the workbook itself. Also, need to be able to add my signature line in. Any help?Sub AST_Email_From_Excel()

Dim emailApplication As Object
Dim emailItem As Object

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

' Now we build the email.

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

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

emailItem.Subject = "Unreturned Techquidation Equipment"

emailItem.Body = "See the attached spreadsheet for unreturned items in your area"

'Attach current Workbook
emailItem.Attachments.Add ActiveWorkbook.FullName

'Attach any file from your computer.
'emailItem.Attachments.Add ("C:\...)"

'Send the email
'emailItem.send

'Display the email so the user can change it as desired before sending
emailItem.Display

Set emailItem = Nothing
Set emailApplication = Nothing

End Sub

crystal Chris

about 2 years ago

#37370

This comment was minimized by the moderator on the site

Hi Chris,The code you provided has been modified. The Outlook signature can now be inserted into the message body. Please give it a try. Thank you.<div data-tag="code">Sub AST_Email_From_Excel()
'Updated by Extendoffice 20220211
Dim emailApplication As Object
Dim emailItem As Object
Set emailApplication = CreateObject("Outlook.Application")
Set emailItem = emailApplication.CreateItem(0)

' Now we build the email.
emailItem.Display 'Display the email so the user can change it as desired before sending
emailItem.to = Range("e2").Value
emailItem.CC = Range("g2").Value
emailItem.Subject = "Unreturned Techquidation Equipment"
emailItem.HTMLBody = "See the attached spreadsheet for unreturned items in your area" & "<br>" & emailItem.HTMLBody

'Attach current Workbook
emailItem.Attachments.Add ActiveWorkbook.FullName

Set emailItem = Nothing
Set emailApplication = Nothing

End Sub

Report

Cmathis crystal

about 2 years ago

#37371

This comment was minimized by the moderator on the site

Hi Crystal,Thank you for getting it to add the signature, doesn't appear to like the HTMLBody section though.When I run the macro, it debugs on emailItem.HTMLBody = "See the attached spreadsheet for unreturned items in your area" & "<br>" & emailItem.HTMLBodyand doesn't complete the rest.

Report

crystal Cmathis

about 2 years ago

#37372

This comment was minimized by the moderator on the site

Hi,
Which Excel version are you using? The following VBA code also can help. Please give it a try. Thanks for your feedback.<div data-tag="code">Sub SendWorkSheet()
'Update by Extendoffice 20220218
Dim xFile As String
Dim xFormat As Long
Dim Wb As Workbook
Dim Wb2 As Workbook
Dim FilePath As String
Dim FileName As String
Dim OutlookApp As Object
Dim OutlookMail As Object
On Error Resume Next
Application.ScreenUpdating = False
Set Wb = Application.ActiveWorkbook
ActiveSheet.Copy
Set Wb2 = Application.ActiveWorkbook
Select Case Wb.FileFormat
Case xlOpenXMLWorkbook:
xFile = ".xlsx"
xFormat = xlOpenXMLWorkbook
Case xlOpenXMLWorkbookMacroEnabled:
If Wb2.HasVBProject Then
xFile = ".xlsm"
xFormat = xlOpenXMLWorkbookMacroEnabled
Else
xFile = ".xlsx"
xFormat = xlOpenXMLWorkbook
End If
Case Excel8:
xFile = ".xls"
xFormat = Excel8
Case xlExcel12:
xFile = ".xlsb"
xFormat = xlExcel12
End Select
FilePath = Environ$("temp") & "\"
FileName = Wb.Name & Format(Now, "dd-mmm-yy h-mm-ss")
Set OutlookApp = CreateObject("Outlook.Application")
Set OutlookMail = OutlookApp.CreateItem(0)
Wb2.SaveAs FilePath & FileName & xFile, FileFormat:=xFormat
'xstr = Range("e2") & " ; " & Range("g2")
With OutlookMail
.Display
.To = Range("e2")
.CC = Range("g2")
.BCC = ""
.Subject = "Unreturned Techquidation Equipment"
.HTMLBody = "See the attached spreadsheet for unreturned items in your area" & "<br>" & .HTMLBody
.Attachments.Add Wb2.FullName
'.Send
End With
Wb2.Close
Kill FilePath & FileName & xFile
Set OutlookMail = Nothing
Set OutlookApp = Nothing
Application.ScreenUpdating = True
End Sub

Report

Cmathis crystal

about 2 years ago

#37373

This comment was minimized by the moderator on the site

Looks to be Excel 2016 and VBA 7.1

Report

samer

about 2 years ago

#36301

This comment was minimized by the moderator on the site

It's really helpful code
I need to change text format from right to left In the xOutMsg line
help please .

Report

Fevro1

about 3 years ago

#33691

This comment was minimized by the moderator on the site

I am trying to integrate this code into the current format I currently have whereby I am able to automate emails within excel based on a set range of values. Any help in regard to where to add the 'signature' code within what I currently have would be much appreciated.

Public Sub CheckAndSendMail()

'Updated by Extendoffice 2018/11/22

Dim xRgDate As Range

Dim xRgSend As Range

Dim xRgText As Range

Dim xRgDone As Range

Dim xOutApp As Object

Dim xMailItem As Object

Dim xLastRow As Long

Dim vbCrLf As String

Dim xMailBody As String

Dim xRgDateVal As String

Dim xRgSendVal As String

Dim xMailSubject As String

Dim I As Long

On Error Resume Next

'Please specify the due date range

xStrRang = "D2:D110"

Set xRgDate = Range(xStrRang)

'Please specify the recipients email address range

xStrRang = "C2:C110"

Set xRgSend = Range(xStrRang)

xStrRang = "A2:A110"

Set xRgName = Range(xStrRang)

'Specify the range with reminded content in your email

xStrRang = "Z2:Z110"

Set xRgText = Range(xStrRang)

xLastRow = xRgDate.Rows.Count

Set xRgDate = xRgDate(1)

Set xRgSend = xRgSend(1)

Set xRgName = xRgName(1)

Set xRgText = xRgText(1)

Set xOutApp = CreateObject("Outlook.Application")

For I = 1 To xLastRow

xRgDateVal = ""

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

If xRgDateVal <> "" Then

If CDate(xRgDateVal) - Date <= 30 And CDate(xRgDateVal) - Date > 0 Then

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

xMailSubject = " JBC Service Agreement Expiring On The " & xRgDateVal

vbCrLf = "

"

xMailBody = ""

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

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

xMailBody = xMailBody & ""

Set xMailItem = xOutApp.CreateItem(0)

With xMailItem

.Subject = xMailSubject

.To = xRgSendVal

.CC = ""

.HTMLBody = xMailBody

.Display

'.Send

End With

Set xMailItem = Nothing

End If

End If

Next

Set xOutApp = Nothing

End Sub

Report

about 4 years ago

#31181

This comment was minimized by the moderator on the site

Thanks to you, I can add signature now but then it removes spaces between paragraph of text. Please Can you Help me ?

Sub helloworld()
Dim OutApp As Object
Dim OutMail As Object
Dim cell As Range
Dim Path As String
Path = Application.ActiveWorkbook.Path
Set OutApp = CreateObject("Outlook.Application")

For Each cell In Range("C4:C6")
Set OutMail = OutApp.CreateItem(0)
With OutMail
.Display
.To = cell.Value
.Subject = Cells(cell.Row, "D").Value
.HTMLBody = "Dear " & Cells(cell.Row, "B").Value & "," _
& vbNewLine & vbNewLine & _
"Warm Greetings" _
& vbNewLine & vbNewLine & _
"We, JK Overseas, would like to take an opportunity and introduce our company J K Overseas, which is involved in the salt business for the last 3 years. We are currently strong in domestic and expanding overseas. We are the supplier of Edible Salt, Water Softening Salt, De-icing Salt, Industrial Salt" & "." _
& vbNewLine & vbNewLine & _
"We have a tie-up with large scale manufacturers in India and procure from them quality Salt and exports. So, we are looking for a reliable expert importer as well as distributor agent to make a long-term Business with mutual benefit" & "." _
& vbNewLine & vbNewLine & _
"Please contact us with your requirement or for any other inquiries you may have. We provide reliable logistics and on-time delivery. We are confident that our prices being most competitive will match your expectations" & "." _
& vbNewLine & vbNewLine & _
.HTMLBody

'.Send
End With
Next cell
End Sub

Report

fadysam

about 4 years ago

#30582

This comment was minimized by the moderator on the site

Dear,
Can someone help me with my VBA,
I need the signature in the email created:

Report

Bara

about 4 years ago

#29613

This comment was minimized by the moderator on the site

Hi, I would need help with my macro, I need to insert the Outlook signature under the table, could you help me with that?

Private Sub CommandButton1_Click()

Dim outlook As Object
Dim newEmail As Object
Dim xInspect As Object
Dim pageEditor As Object

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

With newEmail
.To = Sheet5.Range("F1")
.CC = ""
.BCC = ""
.Subject = Sheet5.Range("B5")
.Body = Sheet5.Range("B41")
.display

Set xInspect = newEmail.GetInspector
Set 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)

.display
Set pageEditor = Nothing
Set xInspect = Nothing
End With

Set newEmail = Nothing
Set outlook = Nothing

End Sub

crystal Bara

about 4 years ago

#29614

This comment was minimized by the moderator on the site

Hi Bara,
Sorry can't help you with that. Thanks for your comment.

Report

Kasun

about 4 years ago

#29072

This comment was minimized by the moderator on the site

Thanks a lot...

There are no comments posted here yet

Please leave your comments in English

Posting as Guest

Name (Required)

Email (Required)

Rate this post:

Reset

0 Characters

🤖	Pomocnik AI Kutools: Zrewolucjonizuj analizę danych w oparciu o: Inteligentne wykonanie \| Wygeneruj kod \| Twórz niestandardowe formuły \| Analizuj dane i generuj wykresy \| Wywołaj funkcje Kutools...
	Popularne funkcje: Znajdź, wyróżnij lub zidentyfikuj duplikaty \| Usuń puste wiersze \| Łącz kolumny lub komórki bez utraty danych \| Okrągły bez wzoru ...
	Super wyszukiwanie: Wiele kryteriów VLookup \| Wiele wartości VLookup \| Przeglądanie pionowe na wielu arkuszach \| Wyszukiwanie rozmyte ....
	Zaawansowana lista rozwijana: Szybko twórz listę rozwijaną \| Zależna lista rozwijana \| Lista rozwijana wielokrotnego wyboru ....
	Menedżer kolumn: Dodaj określoną liczbę kolumn \| Przesuń kolumny \| Przełącz stan widoczności ukrytych kolumn \| Porównaj zakresy i kolumny ...
	Polecane funkcje: Fokus siatki \| Widok projektu \| Duży pasek formuły \| Menedżer skoroszytów i arkuszy \| Biblioteka zasobów (Automatyczny tekst) \| Selektor dat \| Połącz arkusze \| Szyfruj/odszyfruj komórki \| Wysyłaj e-maile według listy \| Super filtr \| Specjalny filtr (filtruj pogrubienie/kursywa/przekreślenie...) ...
	15 najlepszych zestawów narzędzi: 12 Tekst Tools (Dodaj tekst, Usuń znaki, ...) \| 50 + Wykres rodzaje (Wykres Gantta, ...) \| 40+ Praktyczne Wzory (Oblicz wiek na podstawie urodzin, ...) \| 19 Wprowadzenie Tools (Wstaw kod QR, Wstaw obraz ze ścieżki, ...) \| 12 Konwersja Tools (Liczby na słowa, Przeliczanie walut, ...) \| 7 Połącz i podziel Tools (Zaawansowane wiersze łączenia, Podział komórki, ...) \| ... i więcej

Lista zmian

Samouczki dotyczące funkcji

Sprowadź pomoc?