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

Hur infogar jag Outlook-signatur när jag skickar e-post i Excel?

Om du vill skicka ett e-postmeddelande direkt i Excel, hur kan du lägga till standard Outlook-signaturen i e-postmeddelandet? Den här artikeln innehåller två metoder som hjälper dig att lägga till Outlook-signatur när du skickar e-post i Excel.

Infoga signatur i Outlook-e-post när du skickar med Excel VBA
Infoga enkelt Outlook-signatur när du skickar e-post i Excel med ett fantastiskt verktyg

Fler handledning för utskick i Excel ...


Infoga signatur i Outlook-e-post när du skickar med Excel VBA

Till exempel finns det en lista med e-postadresser i ett kalkylblad, för att skicka e-postmeddelanden till alla dessa adresser i Excel och lägga till standard Outlook-signaturen i e-postmeddelandena. Vänligen använd nedanstående VBA-kod för att uppnå det.

1. Öppna kalkylbladet innehåller e-postadresslistan du vill skicka till och tryck sedan på andra + F11 nycklar.

2. I öppningen Microsoft Visual Basic för applikationer fönstret klickar Insert > Modul, och kopiera sedan nedan VBA 2 in i modulkodfönstret.

3. Nu måste du byta ut .Kropp rad in VBA 2 med koden i VBA 1. Flytta sedan linjen .Visa under linjen Med xMailOut.

VBA 1: Mall för att skicka e-postmeddelanden med Outlooks standardsignatur i Excel

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

VBA 2: Skicka e-post till e-postadresser som anges i celler i 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

Följande skärmdump kan hjälpa dig att enkelt hitta skillnaderna efter att du ändrat VBA-koden.

4. tryck på F5 för att köra koden. Då en Kutools för Excel välj rutan dyker upp, välj e-postadresserna du skickar e-post till och klicka sedan på OK.

Sedan skapas e-postmeddelanden. Du kan se Outlooks standardsignatur läggs till i slutet av e-postmeddelandet.

Tips:

  • 1. Du kan ändra e-postadressen i VBA-kod 1 baserat på dina behov.
  • 2. Om en feldialogruta dyker upp efter att ha kört koden, varnar den att användardefinierad typ inte är definierad, stäng den här dialogrutan och klicka sedan på verktyg > Referenser i Microsoft Visual Basic för applikationer fönster. I öppningen Referenser - VBAProject fönstret, kontrollera Microsoft Outlook-objektbibliotek lådan och klicka OK. Och kör sedan koden igen.

Infoga enkelt Outlook-signatur när du skickar e-post i Excel med ett fantastiskt verktyg

Om du är nybörjare i VBA, rekommenderar vi här starkt Skicka e-mail nytta av Kutools för Excel till dig. Med den här funktionen kan du enkelt skicka e-postmeddelanden baserat på vissa fält i Excel och lägga till Outlook-signatur till dem. Gör så här.

Innan du ansöker Kutools för ExcelBer ladda ner och installera det först.

För det första måste du skapa en e-postlista med olika fält som du skickar e-post baserat på.

Du kan skapa en e-postlista manuellt efter behov eller använda funktionen Skapa e-postlista för att snabbt få det gjort.

1. klick Kutools Plus > Skapa e-postlista.

2. I Skapa e-postlista i dialogrutan, ange de fält du behöver, välj var listan ska matas ut och klicka sedan på OK knapp.

3. Nu skapas ett e-postlistaexempel. Eftersom det är en exempellista måste du ändra fälten till visst innehåll som behövs. (flera rader är tillåtna)

4. Därefter väljer du hela listan (inkludera rubriker), klickar på Kutools Plus > Skicka e-mail.

5. I Skicka e-mail dialog ruta:

  • 5.1) Objekt i vald postlista placeras automatiskt i motsvarande fält;
  • 5.2) Avsluta e-postadressen;
  • 5.3) Kontrollera båda Skicka e-post via Outlook och Använd Outlooks signaturinställningar lådor;
  • 5.4) Klicka på Skicka knapp. Se skärmdump:

Nu skickas e-postmeddelanden. Och standard Outlook-signaturen läggs till i slutet av e-postkroppen.

  Om du vill ha en gratis provperiod (30-dag) för detta verktyg, klicka för att ladda ner den, och gå sedan till för att tillämpa operationen enligt ovanstående steg.


Relaterade artiklar:

Skicka e-post till e-postadresser som anges i celler i Excel
Antag att du har en lista med e-postadresser och att du vill skicka e-postmeddelanden till dessa e-postadresser i bulk direkt i Excel. Hur uppnår man det? Den här artikeln visar metoder för att skicka e-post till flera e-postadresser som anges i celler i Excel.

Skicka e-post med kopiering och klistra in ett angivet intervall i e-postkroppen i Excel
I många fall kan ett visst innehållsintervall i Excel-kalkylblad vara användbart i din e-postkommunikation. I den här artikeln kommer vi att introducera en metod för att skicka ett e-postmeddelande med angivet intervall som klistras in i e-postkroppen direkt i Excel.

Skicka e-post med flera bilagor bifogade i Excel
Den här artikeln talar om att skicka ett e-postmeddelande via Outlook med flera bilagor bifogade i Excel.

Skicka e-post om förfallodatum har uppnåtts i Excel
Till exempel, om förfallodagen i kolumn C är mindre än eller lika med 7 dagar (nuvarande datum är 2017/9/13), skicka sedan en e-postpåminnelse till den angivna mottagaren i kolumn A med specificerat innehåll i kolumn B. uppnå det? Den här artikeln ger en VBA-metod för att hantera den i detalj.

Skicka automatiskt e-post baserat på cellvärde i Excel
Antar att du vill skicka ett e-postmeddelande via Outlook till en viss mottagare baserat på ett angivet cellvärde i Excel. Till exempel, när värdet på cell D7 i ett kalkylblad är större än 200, skapas ett e-postmeddelande automatiskt. Den här artikeln introducerar en VBA-metod för dig att snabbt lösa problemet.

Fler handledning för utskick i Excel ...


De bästa Office-produktivitetsverktygen

Kutools för Excel löser de flesta av dina problem och ökar din produktivitet med 80%

  • återanvändning: Sätt snabbt i komplexa formler, diagram och allt som du har använt tidigare; Kryptera celler med lösenord; Skapa e-postlista och skicka e-post ...
  • Super Formula Bar (enkelt redigera flera rader med text och formel); Läslayout (enkelt läsa och redigera ett stort antal celler); Klistra in i filtrerat intervall...
  • Sammanfoga celler / rader / kolumner utan att förlora data; Delat cellinnehåll; Kombinera duplicerade rader / kolumner... Förhindra duplicerade celler; Jämför intervall...
  • Välj Duplicera eller Unikt Rader; Välj tomma rader (alla celler är tomma); Super Find och Fuzzy Find i många arbetsböcker; Slumpmässigt val ...
  • Exakt kopia Flera celler utan att ändra formelreferens; Skapa referenser automatiskt till flera ark; Sätt in kulor, Kryssrutor och mer ...
  • Extrahera text, Lägg till text, ta bort efter position, Ta bort mellanslag; Skapa och skriva ut personsökningstalsatser; Konvertera mellan celler innehåll och kommentarer...
  • Superfilter (spara och tillämpa filterscheman på andra ark); Avancerad sortering efter månad / vecka / dag, frekvens och mer; Specialfilter av fet, kursiv ...
  • Kombinera arbetsböcker och arbetsblad; Sammanfoga tabeller baserat på nyckelkolumner; Dela data i flera ark; Batchkonvertera xls, xlsx och PDF...
  • Mer än 300 kraftfulla funktioner. Stöder Office / Excel 2007-2021 och 365. Stöder alla språk. Enkel implementering i ditt företag eller organisation. Fullständiga funktioner 30 dagars gratis provperiod. 60 dagars pengarna tillbaka-garanti.
kte-flik 201905

Fliken Office ger ett flikgränssnitt till Office och gör ditt arbete mycket enklare

  • Aktivera flikredigering och läsning i Word, Excel, PowerPoint, Publisher, Access, Visio och Project.
  • Öppna och skapa flera dokument i nya flikar i samma fönster, snarare än i nya fönster.
  • Ökar din produktivitet med 50 % och minskar hundratals musklick för dig varje dag!
officetab botten
Sortera kommentarer efter
Kommentarer (29)
Inga betyg än. Bli först med att betygsätta!
Denna kommentar minimerades av moderatoren på webbplatsen
tack så mycket, du räddar mitt liv med den här mallen :D
Denna kommentar minimerades av moderatoren på webbplatsen
Kära Favio,
Glad att hjälpa till.
Denna kommentar minimerades av moderatoren på webbplatsen
fungerar inte med bilagor i Office 2016
Denna kommentar minimerades av moderatoren på webbplatsen
Kära Chris,
VBA-koden nedan kan hjälpa dig. När du har kört koden, välj celler som innehåller e-postadresser som du ska skicka e-postmeddelanden till och välj sedan de filer du behöver bifoga i e-postmeddelandet som bilagor när den andra dialogrutan dyker upp. Och standard Outlook-signaturen kommer också att visas i e-postmeddelandet. Tack för din kommentar.

Sub SendEmailToAddressInCells()
Dim xRg As Range
Dim xRgEach As Range
Dim xRgVal As String
Dim xAddress As String
Dim xOutApp Som Outlook.Application
Dim xMailOut As Outlook.MailItem
On Error Resume Next
xAddress = ActiveWindow.RangeSelection.Address
Set xRg = Application.InputBox("Välj e-postadressintervall", "KuTools for Excel", xAddress, , , , , 8)
Om xRg är ingenting, avsluta Sub
Application.ScreenUpdating = False
Ställ in xOutApp = CreateObject("Outlook.Application")
Ställ in xRg = xRg.SpecialCells(xlCellTypeConstants, xlTextValues)
Ställ in xFileDlg = Application.FileDialog(msoFileDialogFilePicker)
Om xFileDlg.Show = -1 Då
För varje xRgEach In xRg
xRgVal = xRgEach.Value
Om xRgVal Gillar "?*@?*.?*" Då
Ställ in xMailOut = xOutApp.CreateItem(olMailItem)
Med xMailOut
.Visa
.To = xRgVal
.Subject = "Test"
.HTMLBody = "Detta är ett testmeddelande som skickas i Excel" & "
" & .HTMLBody
För varje xFileDlgItem i xFileDlg.SelectedItems
.Attachments.Add xFileDlgItem
Nästa xFileDlgItem
'.Skicka
Sluta med
End If
Nästa
Ställ in xMailOut = Ingenting
Ställ in xOutApp = Ingenting
Application.ScreenUpdating = True
End If
End Sub
Denna kommentar minimerades av moderatoren på webbplatsen
Jag försöker lägga till outlook-signaturen med titeln "default" men verkar inte som om det fungerar.
kan du snälla hjälpa? Jag tror att min "xMailout"-logik är fel. detta är mitt misstänkta defekta område.

Privat underkommando-knappen1_Click ()

Dim xOutApp som objekt
Dim xOutMail som objekt
Dim xMailBody As String
Dim xMailOut As Outlook.MailItem
On Error Resume Next
Ställ in xOutApp = CreateObject("Outlook.Application")
Ställ in xOutMail = xOutApp.CreateItem(0)
xMailBody = "Hälsningar:" & vbNewLine & vbNewLine & _
"Detta är linje 1" & vbNewLine & _
"Detta är linje 2" & vbNewLine & _
"Detta är linje 3" & vbNewLine & _
"Detta är linje 4"
On Error Resume Next
Med xOutMail
.To = "Email.here.com"
.CC = "Email.here.com"
.Subject = "E-posttitel här - " & Range("Cell#").value
.Body = xMailBody
. Attachments.Add ActiveWorkbook.FullName
Ställ in xMailOut = xOutApp.CreateItem(olMailItem)
Med xMailOut
.Visa
Sluta med
ActiveWorkbook.Save
På Fel GoTo 0
Ställ in xOutMail = Ingenting
Ställ in xOutApp = Ingenting
End Sub
Denna kommentar minimerades av moderatoren på webbplatsen
God dag,
Ditt skript har ändrats, försök gärna. Tack.

Privat underkommando-knappen1_Click ()
Dim xOutApp som objekt
Dim xOutMail som objekt
Dim xMailBody As String
Dim xMailOut As Outlook.MailItem
On Error Resume Next
Ställ in xOutApp = CreateObject("Outlook.Application")
Ställ in xOutMail = xOutApp.CreateItem(0)
xMailBody = "Hälsningar:" & vbNewLine & vbNewLine & _
"Detta är linje 1" & vbNewLine & _
"Detta är linje 2" & vbNewLine & _
"Detta är linje 3" & vbNewLine & _
"Detta är linje 4"
On Error Resume Next
Med xOutMail
.To = "Email.here.com"
.CC = "Email.here.com"
.Subject = "E-posttitel här - " & Range("Cell#").Value
.Body = xMailBody
.Attachments.Add ActiveWorkbook.FullName
Ställ in xMailOut = xOutApp.CreateItem(olMailItem)
Med xMailOut
.Visa
Sluta med
Sluta med
ActiveWorkbook.Save
På Fel GoTo 0
Ställ in xOutMail = Ingenting
Ställ in xOutApp = Ingenting
End Sub
Denna kommentar minimerades av moderatoren på webbplatsen
hur man lägger till signatur om makrot används av flera användare.
t.ex. kommer mitt makro att köras av 3 andra personer också. Så hur kan makrot använda signaturen för användaren som kör makrot.
tack på förhand
Denna kommentar minimerades av moderatoren på webbplatsen
God dag,
VBA-koden kan automatiskt känna igen standardsignaturen i avsändarens Outlook och skicka e-post med sin egen signatur via Outlook.
Denna kommentar minimerades av moderatoren på webbplatsen
Om min brödtext är länkad till pull från excel-fält, raderar användningen av & .HTMLBody i slutet av strängen all brödtext och lämnar bara signaturen.
Denna kommentar minimerades av moderatoren på webbplatsen
Jag har problem med att köra detta på excel 2016. Jag får meddelandet "Compile Error: User Defined Type Not Defined". Snälla hjälp!
Denna kommentar minimerades av moderatoren på webbplatsen
Utmärkt!!!!
Denna kommentar minimerades av moderatoren på webbplatsen
Tack så mycket ...
Denna kommentar minimerades av moderatoren på webbplatsen
Hej, jag skulle behöva hjälp med mitt makro, jag måste infoga Outlook-signaturen under bordet, kan du hjälpa mig med det?

Privat underkommando-knappen1_Click ()


Dim utsikt som objekt
Dimma nyE-post som objekt
Dim xInspect As Object
Dim pageEditor som objekt

Ange outlook = CreateObject("Outlook.Application")
Ställ in newEmail = outlook.CreateItem(0)

Med ny e-post
.To = Sheet5.Range("F1")
.CC = ""
.BCC = ""
.Subject = Sheet5.Range("B5")
.Body = Sheet5.Range("B41")
.visa

Ställ in xInspect = newEmail.GetInspector
Ställ in pageEditor = xInspect.WordEditor

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

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

.visa
Ange pageEditor = Ingenting
Ställ in xInspect = Ingenting
Sluta med

Ställ in newEmail = Ingenting
Ange utsikter = Ingenting

End Sub
Denna kommentar minimerades av moderatoren på webbplatsen
Hej Bara,
Jag kan tyvärr inte hjälpa dig med det. Tack för din kommentar.
Denna kommentar minimerades av moderatoren på webbplatsen
Kära,
Kan någon hjälpa mig med min VBA,
Jag behöver signaturen i mejlet som skapades:
Denna kommentar minimerades av moderatoren på webbplatsen
Tack vare dig kan jag lägga till signatur nu men då tar det bort blanksteg mellan textstycket. Snälla kan du hjälpa mig?


Sub helloworld()
Dim OutApp som objekt
Dim OutMail som objekt
Dim cell som intervall
Dim väg som sträng
Sökväg = Application.ActiveWorkbook.Path
Set OutApp = CreateObject("Outlook.Application")

För varje cell inom intervallet("C4:C6")
Set OutMail = OutApp.CreateItem(0)
Med OutMail
.Visa
.Till = cell.Värde
.Subject = Cells(cell.Row, "D").Value
.HTMLBody = "Kära " & Cells(cell.Row, "B").Value & "," _
& vbNewLine & vbNewLine & _
"Vänliga hälsningar" _
& vbNewLine & vbNewLine & _
"Vi, JK Overseas, skulle vilja ta tillfället i akt och presentera vårt företag JK Overseas, som har varit involverat i saltbranschen under de senaste 3 åren. Vi är för närvarande starka inom inhemskt och expanderande utomlands. Vi är leverantör av ätbart salt, Vattenmjukgörande salt, avisningssalt, industrisalt" & "." _
& vbNewLine & vbNewLine & _
"Vi har ett samarbete med storskaliga tillverkare i Indien och köper från dem kvalitetssalt och export. Så vi letar efter en pålitlig expertimportör såväl som distributörsagent för att göra en långsiktig affär med ömsesidig nytta" & " ." _
& vbNewLine & vbNewLine & _
"Kontakta oss med ditt krav eller för andra frågor du kan ha. Vi tillhandahåller pålitlig logistik och leverans i tid. Vi är övertygade om att våra priser som är mest konkurrenskraftiga kommer att matcha dina förväntningar" & "." _
& vbNewLine & vbNewLine & _
.HTMLKropp

'.Skicka
Sluta med
Nästa cell
End Sub
Denna kommentar minimerades av moderatoren på webbplatsen
Jag försöker integrera den här koden i det nuvarande formatet jag har för närvarande, där jag kan automatisera e-postmeddelanden inom Excel baserat på ett visst värdeintervall. All hjälp med avseende på var man kan lägga till "signatur"-koden inom vad jag för närvarande har skulle uppskattas mycket.

Public Sub CheckAndSendMail()

'Uppdaterad av Extendoffice 2018/11/22

Dim xRgDate As Range

Dim xRgSend As Range

Dim xRgText As Range

Dim xRgDone As Range

Dim xOutApp som objekt

Dim xMailItem som objekt

Dim xLast Row 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

'Vänligen ange förfallodatum

xStrang = "D2:D110"

Ställ in xRgDate = Range(xStrang)

'Vänligen ange mottagarens e-postadressintervall

xStrang = "C2:C110"

Ställ in xRgSend = Range(xStrang)

xStrang = "A2:A110"

Ange xRgName = Range(xStrang)

'Ange intervallet med påminnt innehåll i din e-post

xStrang = "Z2:Z110"

Ange xRgText = Range(xStrang)

xLastRow = xRgDate.Rows.Count

Ställ in xRgDate = xRgDate(1)

Ställ in xRgSend = xRgSend(1)

Ställ in xRgName = xRgName(1)

Ställ in xRgText = xRgText(1)

Ställ in xOutApp = CreateObject("Outlook.Application")

För I = 1 Till xLastRow

xRgDateVal = ""

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

Om xRgDateVal <> "" Då

Om CDate(xRgDateVal) - Datum <= 30 Och CDate(xRgDateVal) - Datum > 0 Då

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

xMailSubject = " JBC-tjänstavtal som löper ut den " & xRgDateVal

vbCrLf = "

"

xMailBody = ""

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

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

xMailBody = xMailBody & ""

Ställ in xMailItem = xOutApp.CreateItem(0)

Med xMailItem

.Subject = xMailSubject

.To = xRgSendVal

.CC = "mailcc@justbettercare.com"

.HTMLBody = xMailBody

.Visa

'.Skicka

Sluta med

Ställ in xMailItem = Ingenting

End If

End If

Nästa

Ställ in xOutApp = Ingenting

End Sub
Denna kommentar minimerades av moderatoren på webbplatsen
Det är verkligen användbar kod
Jag behöver ändra textformat från höger till vänster på xOutMsg-raden
hjälp snälla .
Denna kommentar minimerades av moderatoren på webbplatsen
Jag försöker skicka enskilda ark från excel till olika e-postmeddelanden, men det kommer bara att bifoga själva arbetsboken. Måste också kunna lägga till min signaturrad. Någon hjälp? Skicka in AST_Email_From_Excel()

Dimma e-postapplikation som objekt
Dimma e-postobjekt som objekt

Ställ in emailApplication = CreateObject("Outlook.Application")
Ställ in emailItem = emailApplication.CreateItem(0)

' Nu bygger vi e-posten.

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

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

emailItem.Subject = "Ej återlämnad teknisk utrustning"

emailItem.Body = "Se det bifogade kalkylarket för ej returnerade föremål i ditt område"

'Bifoga aktuell arbetsbok
emailItem.Attachments.Add ActiveWorkbook.FullName

'Bifoga valfri fil från din dator.
'emailItem.Attachments.Add ("C:\...)"

'Skicka mejlet
'emailItem.send

'Visa e-postmeddelandet så att användaren kan ändra det efter önskemål innan du skickar
emailItem.Display

Ställ in emailItem = Ingenting
Ställ in emailApplication = Ingenting

End Sub
Denna kommentar minimerades av moderatoren på webbplatsen
Hej Chris, Koden du angav har ändrats. Outlook-signaturen kan nu infogas i meddelandetexten. Ge det ett försök. Tack. Sub AST_Email_From_Excel()
'Uppdaterad av Extendoffice 20220211
Dimma e-postapplikation som objekt
Dimma e-postobjekt som objekt
Ställ in emailApplication = CreateObject("Outlook.Application")
Ställ in emailItem = emailApplication.CreateItem(0)

' Nu bygger vi e-posten.
emailItem.Display 'Visa e-postmeddelandet så att användaren kan ändra det efter önskemål innan det skickas
emailItem.to = Range("e2").Value
emailItem.CC = Range("g2").Value
emailItem.Subject = "Ej återlämnad teknisk utrustning"
emailItem.HTMLBody = "Se det bifogade kalkylarket för ej returnerade föremål i ditt område" & " " & emailItem.HTMLBody

'Bifoga aktuell arbetsbok
emailItem.Attachments.Add ActiveWorkbook.FullName

Ställ in emailItem = Ingenting
Ställ in emailApplication = Ingenting

End Sub
Denna kommentar minimerades av moderatoren på webbplatsen
Hej Crystal, Tack för att du fick den att lägga till signaturen, verkar dock inte gilla HTMLBody-sektionen. När jag kör makrot felsöker det på emailItem.HTMLBody = "Se det bifogade kalkylarket för objekt som inte har returnerats i ditt område" & " " & emailItem.HTMLBodyoch slutför inte resten.  
Denna kommentar minimerades av moderatoren på webbplatsen
Hej,
Vilken Excel-version använder du? Följande VBA-kod kan också hjälpa. Ge det ett försök. Tack för din feedback. Sub SendWorkSheet()
'Uppdatera av Extendoffice 20220218
Dim xFile As String
Dim xFormat As Long
Dim Wb Som arbetsbok
Dim Wb2 Som arbetsbok
Dimma filsökväg som sträng
Dim filnamn som sträng
Dimma OutlookApp som objekt
Dimma OutlookMail som objekt
On Error Resume Next
Application.ScreenUpdating = False
Ställ in Wb = Application.ActiveWorkbook
ActiveSheet.Copy
Ställ in Wb2 = Application.ActiveWorkbook
Välj Case Wb.FileFormat
Case xlOpenXMLWorkbook:
xFile = ".xlsx"
xFormat = xlOpenXMLWorkbook
Fall xlOpenXMLWorkbookMacroEnabled:
Om Wb2.HasVBProject Då
xFile = ".xlsm"
xFormat = xlOpenXMLWorkbookMacroEnabled
annars
xFile = ".xlsx"
xFormat = xlOpenXMLWorkbook
End If
Fall Excel8:
xFile = ".xls"
xFormat = Excel8
Fodral xlExcel12:
xFile = ".xlsb"
xFormat = xlExcel12
Avsluta Välj
FilePath = Environ$("temp") & "\"
Filnamn = Wb.Name & Format(Nu, "dd-mmm-åå h-mm-ss")
Ställ in OutlookApp = CreateObject("Outlook.Application")
Ställ in OutlookMail = OutlookApp.CreateItem(0)
Wb2.SaveAs FilePath & FileName & xFile, FileFormat:=xFormat
'xstr = Range("e2") & " ; " & Range("g2")
Med OutlookMail
.Visa
.To = Range("e2")
.CC = Range("g2")
.BCC = ""
.Subject = "Ej återlämnad Techquidation-utrustning"
.HTMLBody = "Se det bifogade kalkylarket för ej returnerade föremål i ditt område" & " " & .HTMLBody
.Attachments.Add Wb2.FullName
'.Skicka
Sluta med
Wb2.Stäng
Döda FilePath & FileName & xFile
Ställ in OutlookMail = Ingenting
Ställ in OutlookApp = Ingenting
Application.ScreenUpdating = True
End Sub
Denna kommentar minimerades av moderatoren på webbplatsen
Ser ut att vara Excel 2016 och VBA 7.1
Denna kommentar minimerades av moderatoren på webbplatsen
Oi Cristal, en minha makro perde a configuração da assinatura göra e-post, com imagens och formatação original. Como consigo resolver?

Sub Geraremail()

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

Ställ in OLapp = New Outlook.Application
Ange janela = OLapp.CreateItem(olMailItem)

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


Med Janela
ActiveWorkbook.Save
.Visa
.To = Sheets("Base").Range("A2").Value
.CC = Sheets("Base").Range("A5").Värde
.Subject = "Mapa - Acrilo " & Format(Datum, "dd.mm.yy")
assinatura = .Kroppen
.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
.Bilagor.Lägg till Anexo01
Sluta med

End Sub
Denna kommentar minimerades av moderatoren på webbplatsen
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

Ställ in OLapp = New Outlook.Application
Ange janela = OLapp.CreateItem(olMailItem)

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


Med Janela
ActiveWorkbook.Save
.Visa
.To = Sheets("Base").Range("A2").Value
.CC = Sheets("Base").Range("A5").Värde
.Subject = "Mapa - Acrilo " & Format(Datum, "dd.mm.yy")
assinatura = .Kroppen
.HTMLBody = "Prezados/as," & Chr(10) & Chr(10) & "Segue anexo o mapa de Acrilonitrila considerando as vendas previstas no S&OP." & " " & .HTMLBody
.Bilagor.Lägg till Anexo01
Sluta med

End Sub
Denna kommentar minimerades av moderatoren på webbplatsen
Hej Milla,
Följande VBA-kod kan hjälpa dig att ändra teckensnittet för e-posttexten till Calibri, vänligen prova. Tack.
Innan du kör koden måste du klicka verktyg > Hänvisning i Microsoft Visual Basic för applikationer fönstret och kontrollera sedan Microsoft Word -objektbibliotek kryssrutan i rutan Referenser - VBAProject dialogrutan som skärmdumpen som visas nedan.
[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
Denna kommentar minimerades av moderatoren på webbplatsen
Hej Milla,
Följande VBA-kod kan hjälpa dig att ändra teckensnittet för e-posttexten till Calibri, vänligen prova. Tack.
Innan du kör koden måste du klicka verktyg > Hänvisning i Microsoft Visual Basic för applikationer fönstret och kontrollera sedan Microsoft Word -objektbibliotek kryssrutan i rutan Referenser - VBAProject dialogrutan som den bifogade filen som visas nedan.
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
Denna kommentar minimerades av moderatoren på webbplatsen
Hej, jag försöker fixa min VBA-kod. Jag skulle vilja inkludera en av mina outlook-signaturer med en logotyp. Är detta möjligt, och var lägger jag koden som jag använder för närvarande? All hjälp skulle vara bra.

Sub EmailAspdf()

Dim EApp som objekt
Ställ in EApp = CreateObject("Outlook.Application")

Dimma EItem som objekt
Ställ in EItem = EApp.CreateItem(0)

Dim invno As Long
Dim custname As String
Dim amt Som Valuta
Dim dt_issue As Date
Dim term Som Byte
Dim nästarec As Range
Dim väg som sträng
Dim fname As String

invno = Range("I4")
kundnamn = Range("A11")
amt = Range("I42")
dt_issue = Range("I6")
term = Range("I7")
sökväg = "min väg"
fname = invno & " - " & kundnamn

ActiveSheet.ExportAsFixedFormat Typ:=xlTypePDF, IgnorePrintAreas:=False, Filnamn:=sökväg & fname

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

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

Blad3.Hyperlänkar.Lägg till ankare:=nextrec.Offset(0, 6), Adress:=sökväg & fname & ".pdf"

Med EItem

.To = Range("A17")

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

.body = "Hej " & Range("A11") & "," & vbNewLine & vbNewLine _
& "Se den bifogade fakturan för " & Range("A11") & "." & vbNewLine & vbNewLine _
& "Om du har några frågor, tveka inte att kontakta mig." & vbNewLine & vbNewLine _
& "Bäst" & vbNewLine _
& "Mitt namn här" & vbNewLine

.Attachments.Add (sökväg & fname & ".pdf")

.Visa

Sluta med
Exit Sub



End Sub
Denna kommentar minimerades av moderatoren på webbplatsen
Hej RoseAnne,

Du kan manuellt lägga till logotypen i din signatur i förväg innan du använder VBA-koden. Koden måste placeras i modulkodfönstret (tryck på Alt + F11 för att öppna Visual Basic Editor, klicka på Infoga > Modul)
Det finns inga kommentarer här ännu
Lämna dina kommentarer
Postar som gäst
×
Betygsätt detta inlägg:
0   Tecken
Föreslagna platser

Följ oss

Copyright © 2009 - www.extendoffice.com. | Alla rättigheter förbehållna. Drivs av ExtendOffice. | | Sitemap
Microsoft och Office-logotypen är varumärken eller registrerade varumärken som tillhör Microsoft Corporation i USA och / eller andra länder.
Skyddad av Sectigo SSL