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

Hvordan sendes automatisk e-mail baseret på celleværdi i Excel?

Antag, at du vil sende en e-mail via Outlook til en bestemt modtager baseret på en bestemt celleværdi i Excel. For eksempel, når værdien af ​​celle D7 i et regneark er større end 200, oprettes der automatisk en e-mail. Denne artikel introducerer en VBA-metode, som du hurtigt kan løse dette problem.

Send automatisk e-mail baseret på celleværdi med VBA-kode

Send automatisk e-mail baseret på celleværdi med VBA-kode

Gør som følger for at sende en e-mail baseret på celleværdi i Excel.

1. I regnearket skal du sende e-mail baseret på dens celleværdi (her står cellen D7), højreklik på arkfanen og vælg Vis kode fra genvejsmenuen. Se skærmbillede:

2. I popping up Microsoft Visual Basic til applikationer vindue, skal du kopiere og indsætte nedenstående VBA-kode i arkkodevinduet.

VBA-kode: Send e-mail via Outlook baseret på celleværdi i Excel

Dim xRg As Range
'Update by Extendoffice 2018/3/7
Private Sub Worksheet_Change(ByVal Target As Range)
    On Error Resume Next
    If Target.Cells.Count > 1 Then Exit Sub
  Set xRg = Intersect(Range("D7"), Target)
    If xRg Is Nothing Then Exit Sub
    If IsNumeric(Target.Value) And Target.Value > 200 Then
        Call Mail_small_Text_Outlook
    End If
End Sub
Sub Mail_small_Text_Outlook()
    Dim xOutApp As Object
    Dim xOutMail As Object
    Dim xMailBody As String
    Set xOutApp = CreateObject("Outlook.Application")
    Set xOutMail = xOutApp.CreateItem(0)
    xMailBody = "Hi there" & vbNewLine & vbNewLine & _
              "This is line 1" & vbNewLine & _
              "This is line 2"
    On Error Resume Next
    With xOutMail
        .To = "Email Address"
        .CC = ""
        .BCC = ""
        .Subject = "send by cell value test"
        .Body = xMailBody
        .Display   'or use .Send
    End With
    On Error GoTo 0
    Set xOutMail = Nothing
    Set xOutApp = Nothing
End Sub

Noter:

1). I VBA-koden, D7 og værdi> 200 er cellen og celleværdien, du vil sende e-mail baseret på.
2). Skift e-mail-kroppen, som du har brug for xMailBody linje i koden.
3). Erstat e-mail-adressen med modtagerens e-mailadresse på linje .To = "E-mail-adresse".
4). Og angiv Cc- og Bcc-modtagere, som du har brug for i .CC = "" og Bcc = "" sektioner.
5). Skift endelig e-mailens emne på linje .Subject = "send med celleværditest".

3. Tryk på andre + Q tasterne sammen for at lukke Microsoft Visual Basic til applikationer vindue.

Fra nu af, når den værdi, du indtaster i celle D7, er større end 200, oprettes der automatisk en e-mail med specificerede modtagere og brødtekster i Outlook. Du kan klikke på Send knappen for at sende denne e-mail. Se skærmbillede:

Noter:

1. VBA-koden fungerer kun, når du bruger Outlook som dit e-mail-program.

2. Hvis de indtastede data i celle D7 er en tekstværdi, vises mailvinduet også.

Send nemt e-mail via Outlook baseret på felter i den oprettede postliste i Excel:

Send emails nytte af Kutools til Excel hjælper brugere med at sende e-mail via Outlook baseret på oprettet mailingliste i Excel.
Download og prøv det nu! (30-dag gratis spor)

Relaterede artikler:

De bedste Office-produktivitetsværktøjer

Kutools til Excel løser de fleste af dine problemer og øger din produktivitet med 80%

  • Genbruge: Indsæt hurtigt komplekse formler, diagrammer og alt, hvad du har brugt før; Krypter celler med adgangskode Opret postliste og send e-mails ...
  • Super formel bar (let redigere flere linjer med tekst og formel); Læsning Layout (let at læse og redigere et stort antal celler); Indsæt til filtreret rækkevidde...
  • Flet celler / rækker / kolonner uden at miste data; Split celler indhold; Kombiner duplikerede rækker / kolonner... Forhindre duplikerede celler; Sammenlign områder...
  • Vælg Duplicate eller Unique Rækker; Vælg tomme rækker (alle celler er tomme); Super Find og Fuzzy Find i mange arbejdsbøger; Tilfældig valg ...
  • Præcis kopi Flere celler uden at ændre formelreference; Auto Opret referencer til flere ark; Indsæt kugler, Afkrydsningsfelter og mere ...
  • Uddrag tekst, Tilføj tekst, Fjern efter position, Fjern mellemrum; Opret og udskriv personsøgningssubtotaler; Konverter mellem celler indhold og kommentarer...
  • Superfilter (gem og anvend filterskemaer på andre ark); Avanceret sortering efter måned / uge / dag, hyppighed og mere; Specielt filter af fed, kursiv ...
  • Kombiner arbejdsbøger og arbejdsark; Fletabeller baseret på nøglekolonner; Opdel data i flere ark; Batch Konverter xls, xlsx og PDF...
  • Mere end 300 kraftfulde funktioner. Understøtter Office / Excel 2007-2021 og 365. Understøtter alle sprog. Nem implementering i din virksomhed eller organisation. Fuld funktioner 30-dages gratis prøveperiode. 60 dages pengene tilbage garanti.
kte-fane 201905

Fanen Office bringer en grænseflade til et kontor med Office, og gør dit arbejde meget lettere

  • Aktiver redigering og læsning af faner i Word, Excel, PowerPoint, Publisher, Access, Visio og Project.
  • Åbn og opret flere dokumenter i nye faner i det samme vindue snarere end i nye vinduer.
  • Øger din produktivitet med 50 % og reducerer hundredvis af museklik for dig hver dag!
officetab bund
Sorter kommentarer efter
Ældste først
Nyeste først
Kommentarer (308)
Bedømt 5 ud af 5 · 1 vurderinger
Debbie
Debbie
Denne kommentar blev minimeret af moderatoren på webstedet
Hvordan skal koden modificeres, så den gælder for en hel række af celler?
Svar
0
0
krystal
krystal     Debbie
Denne kommentar blev minimeret af moderatoren på webstedet
Kære Debbie,
Prøv venligst nedenstående VBA-kode for at løse problemet.

Privat Sub Worksheet_Change (ByVal Target As Range)
Hvis Target.Cells.Count > 1 Afslut Sub
Hvis (Ikke skærende(Mål, Range("A1:D4")) Er Intet) Og (Målværdi > 200) Så
Ring til Mail_small_Text_Outlook
End If
End Sub
Sub Mail_small_Text_Outlook()
Dim xOutApp som objekt
Dim xOutMail som objekt
Dim xMailBody As String
Indstil xOutApp = CreateObject("Outlook.Application")
Indstil xOutMail = xOutApp.CreateItem(0)
xMailBody = "Hej" & vbNewLine & vbNewLine & _
"Dette er linje 1" & vbNewLine & _
"Dette er linje 2"
On Error Resume Next
Med xOutMail
.To = "Din modtagers e-mailadresse"
.CC = ""
.BCC = ""
.Subject = "send med celleværditest"
.Body = xMailBody
.Vis 'eller brug .Send
Slut med
På Fejl GoTo 0
Indstil xOutMail = Ingenting
Indstil xOutApp = Ingenting
End Sub
Svar
Rapport
0
0
Jordan
Jordan
Denne kommentar blev minimeret af moderatoren på webstedet
Jeg har problemer med at få denne kode til at spørge, hvis værdien i cellen ændres indirekte. For eksempel, hvis jeg har Sum-ligning, ændres denne værdi automatisk. Når ligningen kører, og værdien går over den indstillede værdi for at bede e-mailen, gør den det ikke, medmindre jeg fysisk ændrer tallet selv. Er der en måde at få e-mailen til at spørge, selvom den ændres indirekte?
Svar
0
0
krystal
krystal     Jordan
Denne kommentar blev minimeret af moderatoren på webstedet
Kære Jordan,
Følgende VBA-kode kan hjælpe dig med at løse problemet. Glem ikke at erstatte "E-mail-adressen" med modtagerens e-mailadresse i koden. Tak skal du have.

Privat Sub Worksheet_Change (ByVal Target As Range)
Dim xRgPre As Range
On Error Resume Next
Hvis Target.Cells.Count > 1 Afslut Sub
Indstil xRg = Range ("D7")
Indstil xRgPre = xRg.Precedents
Hvis xRg.Value > 200 Så
Hvis Target.Address = xRg.Address Så
Ring til Mail_small_Text_Outlook
ElseIf (Ikke xRgPre Is Nothing) Og (Skæringspunkt(Target, xRgPre).Address = Target.Address) Så
Ring til Mail_small_Text_Outlook
End If
End If
End Sub
Sub Mail_small_Text_Outlook()
Dim xOutApp som objekt
Dim xOutMail som objekt
Dim xMailBody As String
Indstil xOutApp = CreateObject("Outlook.Application")
Indstil xOutMail = xOutApp.CreateItem(0)
xMailBody = "Hej" & vbNewLine & vbNewLine & _
"Dette er linje 1" & vbNewLine & _
"Dette er linje 2"
On Error Resume Next
Med xOutMail
.To = "E-mail-adresse"
.CC = ""
.BCC = ""
.Subject = "send med celleværditest"
.Body = xMailBody
.Vis 'eller brug .Send
Slut med
På Fejl GoTo 0
Indstil xOutMail = Ingenting
Indstil xOutApp = Ingenting
End Sub
Svar
Rapport
0
0
Daniel
Daniel     krystal
Denne kommentar blev minimeret af moderatoren på webstedet
Jeg har ændret den foreslåede kode for at prøve at få den til at fungere for min applikation.
Ændret xRg = Range("C2:C40") og If xRg.Value = -1.

Det problem, jeg har, er, når der er en ændring af en celle, og så længe en af ​​cellerne i mit område er = -1, kalder den Mail_small_Text_Outlook.
Jeg forsøger kun at ringe, hvis en celle i mit område ændres indirekte til -1.
Jeg spekulerede også på, om og hvordan det ville være muligt at få det til at opfylde to kriterier.
Som at tjekke rækkevidde A og område B, og hvis de opfylder kriterierne kalder funktion.

På forhånd tak for hjælpen. Jeg er ny til alt dette, men at læse denne tråd har mig omkring 90% der.


Privat Sub Worksheet_Change (ByVal Target As Range)
Dim xRgPre As Range
On Error Resume Next
Hvis Target.Cells.Count > 1 Afslut Sub
Indstil xRg = Range("C2:C40")
Indstil xRgPre = xRg.Precedents
Hvis xRg.Value = -1 Så
Hvis Target.Address = xRg.Address Så
Ring til Mail_small_Text_Outlook
ElseIf (Ikke xRgPre Is Nothing) Og (Skæringspunkt(Target, xRgPre).Address = Target.Address) Så
Ring til Mail_small_Text_Outlook
End If
End If
End Sub
Svar
Rapport
0
0
Jim
Jim     krystal
Denne kommentar blev minimeret af moderatoren på webstedet
Jeg brugte denne kode med den eneste ændring, at jeg har anvendt den på en hel kolonne [Set xRg = Range("D4:D13")]. Nu udløses hændelsen, hver gang der foretages en beregning, uanset om ventilen i kolonne D er under målværdien. Nogen idé om hvorfor det er?


Dim Xrg As Range
Privat Sub Worksheet_Change (ByVal Target As Range)
Dim xRgPre As Range
On Error Resume Next
Hvis Target.Cells.Count > 1 Afslut Sub
Indstil Xrg = Range("D4:D13")
Indstil xRgPre = Xrg.Precedents
Hvis Xrg.Value < 1200 Så
Hvis Target.Address = Xrg.Address Så
Ring til Mail_small_Text_Outlook
ElseIf (Ikke xRgPre Is Nothing) Og (Skæringspunkt(Target, xRgPre).Address = Target.Address) Så
Ring til Mail_small_Text_Outlook
End If
End If
End Sub

Sub Mail_small_Text_Outlook()
Dim xOutApp som objekt
Dim xOutMail som objekt
Dim xMailBody As String
Indstil xOutApp = CreateObject("Outlook.Application")
Indstil xOutMail = xOutApp.CreateItem(0)
xMailBody = "Hej" & vbNewLine & _
"Test vba" _
& vbNewLine & _
"Linje 2."
On Error Resume Next
Med xOutMail
.Til = ""
.CC = ""
.BCC = ""
.Subject = "Automatisk e-mailtest"
.Body = xMailBody
.Skærm
Slut med
På Fejl GoTo 0
Indstil xOutMail = Ingenting
Indstil xOutApp = Ingenting

End Sub


Tak.
Svar
0
0
Shawn Henry
Shawn Henry
Denne kommentar blev minimeret af moderatoren på webstedet
Hej

Jeg har problemer, fordi e-mail-modtager skal tilføjes igen og igen én efter én. Vejledning om listen over e-mail-modtagere kan føjes til denne funktion, så funktionen vil vælge e-mailadressen fra listen over angivne e-mail-adresser eller liste upload, og funktionen sender e-mailen, som allerede er oprettet til den ønskede modtager.
Svar
0
0
krystal
krystal     Shawn Henry
Denne kommentar blev minimeret af moderatoren på webstedet
Kære Henry,
Følgende VBA-kode kan hjælpe dig med at løse problemet. Placer venligst VBA-scriptet i dit regnearksmodul. Når værdien i den angivne celle opfylder betingelsen, vil en Kutools for Excel-dialogboks dukke op, vælg venligst de celler, der indeholder modtagernes e-mailadresser, og klik derefter på knappen OK. Så åbner e-mails med specificerede modtagere. Send dem gerne efter behov.

Privat Sub Worksheet_Change (ByVal Target As Range)
Hvis Target.Cells.Count > 1 Afslut Sub
Indstil xRg = Range ("D7")
Hvis xRg = Target And Target.Value > 200 Så
Ring til Mail_small_Text_Outlook
End If
End Sub
Sub Mail_small_Text_Outlook()
Dim xOutApp som objekt
Dim xOutMail som objekt
Dim xMailBody As String
Dim xRgMsg As Range
Dim xCell As Range
Indstil xRgMsg = Application.InputBox("Vælg venligst adressecellerne：", "Kutools for Excel", , , , , , 8)
xMailBody = "Hej" & vbNewLine & vbNewLine & _
"Dette er linje 1" & vbNewLine & _
"Dette er linje 2"
On Error Resume Next
For hver xcelle i xRgMsg
Indstil xOutApp = CreateObject("Outlook.Application")
Indstil xOutMail = xOutApp.CreateItem(0)
Med xOutMail
.To = xCell.Value
.CC = ""
.BCC = ""
.Subject = "send med celleværditest"
.Body = xMailBody
.Vis 'eller brug .Send
Slut med
xOutApp = Intet
xOutMail = Intet
Næste
På Fejl GoTo 0
End Sub
Svar
Rapport
0
0
Brahma
Brahma
Denne kommentar blev minimeret af moderatoren på webstedet
vil det blive sendt automatisk mail, uden nogen manuel afbrydelse
Svar
0
0
krystal
krystal     Brahma
Denne kommentar blev minimeret af moderatoren på webstedet
Kære Brahma,
Hvis du ønsker at sende e-mailen direkte uden at blive vist, skal du erstatte linjen ".Display" med ".Send" i ovenstående VBA-kode.
Svar
Rapport
0
0
basilikum
basilikum
Denne kommentar blev minimeret af moderatoren på webstedet
Hej jeg har lagt det samme script, men det virker ikke, hjælp mig venligst i 1. del

Dim xRg As Range

Privat Sub Worksheet_Change (ByVal Target As Range)
Hvis Target.Cells.Count > 1 Afslut Sub
Indstil xRg = Range ("D7")
Hvis xRg = Target And Target.Value = 200 Så
Ring til Mail_small_Text_Outlook
End If

End Sub
Svar
0
0
krystal
krystal     basilikum
Denne kommentar blev minimeret af moderatoren på webstedet
Kære basilikum,
Er der nogen advarsel, når du kører koden?
Svar
Rapport
0
0
Jose Manuel
Jose Manuel
Denne kommentar blev minimeret af moderatoren på webstedet
Hej, hvordan ville du ændre denne kode for at kontrollere, om en gruppe celler har strengen "No match" og sende en e-mail, hvis den har.
Svar
0
0
krystal
krystal     Jose Manuel
Denne kommentar blev minimeret af moderatoren på webstedet
Kære José,
Prøv venligst nedenstående VBA-kode. Når du kører koden, dukker en dialogboks op, vælg venligst det område, du vil tjekke for streng, og klik på OK-knappen. hvis strengen ikke eksisterer, vil du få en prompt dialogboks. Hvis strengen findes i området, vises en e-mail med specificeret modtager, emne og brødtekst.

Sub SendE-mail()
Dim I Så længe
Dim J As Long
Dim xRg As Range
Dim xArr
Dim xOutApp som objekt
Dim xOutMail som objekt
Dim xMailBody As String
Dim xFlag As Boolean
On Error Resume Next
Indstil xRg = Application.InputBox("Vælg venligst område", "Kutools til Excel", Selection.Address, , , , , 8)
Hvis xRg ikke er noget, skal du afslutte Sub
xArr = xRg.Værdi
xFlag = Falsk
For I = 1 Til UBound(xArr)
For J = 1 Til UBound(xArr, 2)
Hvis xArr(I, J) = "Ingen match" Så
xFlag = Sandt
End If
Næste
Næste
Hvis xFlag Så
Indstil xOutApp = CreateObject("Outlook.Application")
Indstil xOutMail = xOutApp.CreateItem(0)
xMailBody = "Hej" & vbNewLine & vbNewLine & _
"Dette er linje 1" & vbNewLine & _
"Dette er linje 2"
Med xOutMail
.To = "E-mailadresse"
.CC = ""
.BCC = ""
.Subject = "Match"
.Body = xMailBody
.Vis 'eller brug .Send
Slut med
Else
MsgBox "Fundet ingen matchende værdi", vbInformation, "KuTools til Excel"
End If
End Sub
Svar
Rapport
0
0
Åben
Åben
Denne kommentar blev minimeret af moderatoren på webstedet
Hvordan kunne jeg ændre denne kode til at sende elevkarakterer til forældre. Hvor hvis kolonne A er karakteren, og kolonne B er den overordnede e-mail. Jeg vil udfylde en e-mail for hver elev med et F som karakter.
Svar
Rapport
0
0
krystal
krystal     Åben
Denne kommentar blev minimeret af moderatoren på webstedet
Kære Frank,
Nedenstående VBA-kode kan hjælpe dig med at løse problemet. Tak skal du have.

Sub Mail_small_Text_Outlook()
Dim xRg As Range
Dim I Så længe
Dim x Rows As Long
Dim xVal Som streng
Dim xOutApp som objekt
Dim xOutMail som objekt
Dim xMailBody As String
On Error Resume Next
Indstil xRg = Application.InputBox("Vælg venligst karakterkolonnen og e-mailkolonnen (to kolonner)", "Kutools for Excel", Selection.Address, , , , , 8)
Hvis xRg ikke er noget, skal du afslutte Sub
xRows = xRg.Rows.Count
Indstil xRg = xRg(2)
For I = 1 Til xRows
xVal = xRg.Offset(I, -1).Tekst
Hvis xVal = "F" Så
Indstil xOutApp = CreateObject("Outlook.Application")
Indstil xOutMail = xOutApp.CreateItem(0)
xMailBody = "Hej" & vbNewLine & vbNewLine & _
"Dette er dit barns karakter" & xRg.Offset(I, -1).Tekst
Med xOutMail
.to = xRg.Offset(I, 0).Tekst
.Subject = "send med celleværditest"
.Body = xMailBody
.Vis 'eller brug .Send
Slut med
På Fejl GoTo 0
Indstil xOutMail = Ingenting
Indstil xOutApp = Ingenting
End If
Næste
End Sub
Svar
Rapport
0
0
Dhruv
Dhruv
Denne kommentar blev minimeret af moderatoren på webstedet
Jeg har en liste over e-mailadresser allerede i en excel-fil, hvordan kan jeg ændre koden til automatisk at vælge e-mailadressen på personen, hvis hans celle D7 er >200?
Svar
0
0
krystal
krystal     Dhruv
Denne kommentar blev minimeret af moderatoren på webstedet
Good Day,
Følgende VBA-kode kan hjælpe dig med at løse problemet. Placer venligst VBA-scriptet i dit regnearksmodul. Når værdien i den angivne celle opfylder betingelsen, vil en Kutools for Excel-dialogboks dukke op, vælg venligst de celler, der indeholder modtagernes e-mailadresser, og klik derefter på knappen OK. Så åbner e-mails med specificerede modtagere. Send dem gerne efter behov.

Privat Sub Worksheet_Change (ByVal Target As Range)
Hvis Target.Cells.Count > 1 Afslut Sub
Indstil xRg = Range ("D7")
Hvis xRg = Target And Target.Value > 200 Så
Ring til Mail_small_Text_Outlook
End If
End Sub
Sub Mail_small_Text_Outlook()
Dim xOutApp som objekt
Dim xOutMail som objekt
Dim xMailBody As String
Dim xRgMsg As Range
Dim xCell As Range
Indstil xRgMsg = Application.InputBox("Vælg venligst adressecellerne：", "Kutools for Excel", , , , , , 8)
xMailBody = "Hej" & vbNewLine & vbNewLine & _
"Dette er linje 1" & vbNewLine & _
"Dette er linje 2"
On Error Resume Next
For hver xcelle i xRgMsg
Indstil xOutApp = CreateObject("Outlook.Application")
Indstil xOutMail = xOutApp.CreateItem(0)
Med xOutMail
.To = xCell.Value
.CC = ""
.BCC = ""
.Subject = "send med celleværditest"
.Body = xMailBody
.Vis 'eller brug .Send
Slut med
xOutApp = Intet
xOutMail = Intet
Næste
På Fejl GoTo 0
End Sub
Svar
Rapport
0
0
mayank vijay
mayank vijay
Denne kommentar blev minimeret af moderatoren på webstedet
Jeg har problemer med at sende mail via outlook. Jeg modtager fejlen, der siger "Et program forsøger at sende en e-mail på dine vegne. Hvis det er uventet, bedes du afvise og kontrollere, at din antivirussoftware er opdateret"
Hjælp venligst, da jeg ikke er i stand til at automatisere det.
Svar
Rapport
0
0
krystal
krystal     mayank vijay
Denne kommentar blev minimeret af moderatoren på webstedet
Undskyld Mayank,
Koden fungerer godt i mit tilfælde. Det ser ud til, at noget om "send på vegne"-funktionen er konfigureret i din Outlook. Tjek lige efter det.
Svar
Rapport
0
0
New2Excel
New2Excel
Denne kommentar blev minimeret af moderatoren på webstedet
Hej, hvilken kode vil jeg bruge, hvis jeg prøver at sende en e-mail til en leder, der har en liste over frugten, der har en mængde > 200 en gang om måneden (baseret på dit eksempel) eller udløber snart (baseret på datoer)
Svar
0
0
krystal
krystal     New2Excel
Denne kommentar blev minimeret af moderatoren på webstedet
Good Day
Kan være metoden i denne artikel "Hvordan sender man e-mail, hvis forfaldsdatoen er overholdt i Excel?" kan hjælpe dig.
Følg venligst dette link: https://www.extendoffice.com/documents/excel/4664-excel-send-email-if-due-date-has-been-met.html
Svar
Rapport
0
0
Doug
Doug
Denne kommentar blev minimeret af moderatoren på webstedet
Hvordan kan jeg redigere koden for at sende en e-mail baseret på en dato i cellen. For eksempel har jeg brug for et dokument, der bliver gennemgået hver 15. måned, og jeg vil sende en e-mail efter 12 måneder til en e-mailadresse, hvor der står, at dokumentet skal gennemgås. Jeg har nu fået det til automatisk at sende en e-mail ved at ændre .Vis til .Send og det fungerer fint som skrevet, men hvad skal jeg ændre for at bruge en datofunktion i stedet for et helt tal??
Svar
0
0
Savio Jois
Savio Jois
Denne kommentar blev minimeret af moderatoren på webstedet
Hvordan kan du tilføje Multiple Range til "Set xRg = Range("D7")". Jeg vil redigere det og tilføje Range("D7:F7"). Men jeg får fejlen Run Time Error 13, Type Mismatch, og det fører mig til If xRg = Target And Target.Value > 2 Then.


Hvordan kan jeg løse dette problem?
Svar
Rapport
0
0
krystal
krystal     Savio Jois
Denne kommentar blev minimeret af moderatoren på webstedet
Good Day,
Prøv venligst nedenstående VBA-kode for at løse problemet.

Privat Sub Worksheet_Change (ByVal Target As Range)
Hvis Target.Cells.Count > 1 Afslut Sub
Hvis (Ikke skærende(Mål, Range("D7:F7")) Er Intet) Og (Target.Value > 200) Så
Ring til Mail_small_Text_Outlook
End If
End Sub
Sub Mail_small_Text_Outlook()
Dim xOutApp som objekt
Dim xOutMail som objekt
Dim xMailBody As String
Indstil xOutApp = CreateObject("Outlook.Application")
Indstil xOutMail = xOutApp.CreateItem(0)
xMailBody = "Hej" & vbNewLine & vbNewLine & _
"Dette er linje 1" & vbNewLine & _
"Dette er linje 2"
On Error Resume Next
Med xOutMail
.To = "Din modtagers e-mailadresse"
.CC = ""
.BCC = ""
.Subject = "send med celleværditest"
.Body = xMailBody
.Vis 'eller brug .Send
Slut med
På Fejl GoTo 0
Indstil xOutMail = Ingenting
Indstil xOutApp = Ingenting
End Sub
Svar
Rapport
1
0
Savio Jois
Savio Jois     krystal
Denne kommentar blev minimeret af moderatoren på webstedet
fungerede helt fint.. Tak..:):)
Svar
Rapport
0
0
Nitol
Nitol     krystal
Denne kommentar blev minimeret af moderatoren på webstedet
Det virker ikke for mig, da værdien i D7 er et resultat af en formel. Hvad hvis celle D7 indeholder en formel, f.eks. D7 =2*120? Den opfylder stadig betingelsen, men der sker ikke noget. Hjælp venligst
Svar
0
0
Hanizah Ismail
Hanizah Ismail
Denne kommentar blev minimeret af moderatoren på webstedet
hvordan stopper man kode i at køre, dvs. beder ikke e-mailen, når betingelsen ikke er opfyldt?

selv når D7 < 200, bliver jeg stadig bedt om e-mailen.
Svar
Rapport
0
0
krystal
krystal     Hanizah Ismail
Denne kommentar blev minimeret af moderatoren på webstedet
Good Day,
Koden opdateres i indlægget med problemet løst. Tak for din kommentar.
Svar
Rapport
0
0
Ann
Ann
Denne kommentar blev minimeret af moderatoren på webstedet
Hi

Mange tak for at poste denne VBA-kode og instruktioner. Da jeg fandt det, følte jeg, at jeg havde vundet i lotto. Men jeg sidder fast på noget, så jeg håber du kan hjælpe (jeg er ny til VBA, har kun meget grundlæggende forståelse).

Jeg har kopieret koden og ændret celle- og celleværdien for at vælge fra et område, hvis et kriterium er opfyldt. Jeg har prøvet og testet, og det virker, og jeg modtog en e-mail til outlook baseret på kriterierne.

1) Jeg kan dog ikke finde ud af, hvordan jeg får VBA-koden til at køre automatisk, når jeg åbner excel-regnearket, i stedet for at skulle klikke på VBA-applikationen og vælge kør. Kan du rådgive, hvis der er en ekstra prompt om at indtaste VBA-koden ovenfor, der vil gøre dette, eller skal det gøres separat.

2) Er der også en måde at få VBA-koden til at sende en mail til en person, hvis forfaldsdatoen er ja for en bestemt vare som vist i eksemplet nedenfor.
e-mail skjult kolonne
Navn

Procedure
Procedure nr.1 forfaldsdato ja
Procedure nr. 2 forfaldsdato nr

Jeg ville have adskillige personer i regnearket (som går på tværs vandret i en række), og 'Ja' kunne fremhæves for forskellige forfaldne procedurer (angivet lodret i kolonne A. Er der en måde at oprette en VBA-kode, der kører for noget som dette - hvis 'Ja' for 'Person 1', så send en e-mail til 'person 1' med 'procedure nr. #' (eller tal) og forfaldsdato(er) At kunne angive alle procedurer og deres efterfølgende forfaldsdatoer i e-mailen.

Jeg ville ikke have noget imod, hvis jeg skulle indstille en separat VBA-kode for hver person, så længe den sendte en mail med alle de forfaldne dokumenter for den pågældende person og forfaldsdatoer.

Håber du kan hjælpe
Svar
Rapport
0
0
krystal
krystal     Ann
Denne kommentar blev minimeret af moderatoren på webstedet
Kære Ann,
Prøv venligst nedenstående VBA-kode. Tak for din kommentar.

Sub Mail_small_Text_Outlook()
Dim xRg As Range
Dim xCell As Range
Dim I Så længe
Dim x Rows As Long
Dim xCols As Long
Dim xVal Som streng
Dim xOutApp som objekt
Dim xOutMail som objekt
Dim xMailBody As String
On Error Resume Next
Set xRg = Application.InputBox("Vælg intervallet indeholder den celleværdi, du vil sende e-mails baseret på:", "Kutools for Excel", Selection.Address, , , , , 8)
Hvis xRg ikke er noget, skal du afslutte Sub
xRows = xRg.Rows.Count
xCols = xRg.Columns.Count
For I = 1 Til xRows
Indstil xCell = xRg(I, xCols)
Hvis xCell.Value = "Ja" Så
Indstil xOutApp = CreateObject("Outlook.Application")
Indstil xOutMail = xOutApp.CreateItem(0)
xMailBody = "Hej" & vbNewLine & vbNewLine & _
"Dette er dine oplysninger: " & vbNewLine & xCell.Offset(0, -1).Text & vbNewLine & xCell.Offset(0, -2).Text
Med xOutMail
.To = xCell.Offset(0, -4).Tekst
.Subject = "send med celleværditest"
.Body = xMailBody
.Vis 'eller brug .Send
Slut med
På Fejl GoTo 0
Indstil xOutMail = Ingenting
Indstil xOutApp = Ingenting
End If
Næste
End Sub
Svar
Rapport
0
0
Jermaine
Jermaine     krystal
Denne kommentar blev minimeret af moderatoren på webstedet
Krystal,

Dette erstatter følgende kode:

Sub-e-mail()

Dim xRg As Range

Dim xRgEach As Range

Dim xEmail_Subject, xEmail_Send_Form,;osv.
Svar
0
0
Jacob
Jacob     krystal
Denne kommentar blev minimeret af moderatoren på webstedet
Hvor præcist indsætter vi denne kode?
Svar
0
0
krystal
krystal     Jacob
Denne kommentar blev minimeret af moderatoren på webstedet
God dag,
Du skal placere koden i regnearkets kodevindue.
Åbn vinduet Microsoft Visual Basic for Applications, dobbeltklik på arknavnet i venstre rude for at åbne kodeeditoren.
Svar
Rapport
0
0
Martyn
Martyn
Denne kommentar blev minimeret af moderatoren på webstedet
Hej der,


Jeg har i øjeblikket lidt problemer med denne kodning (nyt til dette - kan have bidt mere af, end jeg kan tygge)


Jeg har i øjeblikket et regneark med følgende, som jeg har brug for hjælp til at automatisere og sende e-mail for fejl, der er på vores ejendomme for vores virksomhed


Jeg har i øjeblikket brug for en kode, der vil bruge følgende data:


1) En adresse og problemet ( 2 "generelle" celler, der er blevet flettet via ((I celle D1)) " = =CONCAT(B1," "C1,) "
Adressen i B1 vil altid være den samme (mere eller mindre)
Mens C1 altid vil ændre sig afhængig af fejlen på ejendommen.


2) En e-mail, der skal sendes med den samme e-mail-adresse, (kan jeg bruge $E$1, eller jeg skal bruge E1 - E1 f.eks.) eller kan jeg bare indtaste "TheEmailAdress@.co.uk" i kodelinjen


3) E-mail-brødteksten, der skal udfyldes på samme måde som punkt 1) ...... ((I celle F1)) " =CONCAT(G1," ",H1)
Disse vil ændre sig konstant, da de repræsenterer virksomheden (G1) og hvad de laver, reparerer, citerer ect (H1)

4) Udløseren til at sende e-mailen afsted, jeg ville være nummer 7, arket bliver opdateret dagligt (7 dage om ugen)
som sådan har jeg brug for triggeren til at sende e-mailen på dag 7, men ikke konstant som på dag 8, 9, 10+ ect. og ikke før som 1-6, dette ville være i A4 : A 100+ (da vi konstant udvider


4) Jeg har brugt små uddrag fra andre brugere, der nævnte om at bruge en liste til triggeren til at sende e-mailen, men jeg er ikke sikker på, om den var 100 % korrekt, men jeg ville have brug for den til at scanne gennem alle Collum A... A4: A100
og hvis der er 47 celler, der kun indeholder " 7 ", vil 47 e-mails blive sendt


Mange tak fordi du læste med, og jeg håber du kan hjælpe :)
Svar
Rapport
0
0
krystal
krystal     Martyn
Denne kommentar blev minimeret af moderatoren på webstedet
Kære martyn,
Jeg kan desværre ikke hjælpe med dette.
Du kan stille dit spørgsmål i vores forum: https://www.extendoffice.com/forum.html for at få mere Excel-support fra vores tekniske personale.
Tak for din kommentar.

Venlig hilsen,
Krystal
Svar
Rapport
0
0
Jesse
Jesse
Denne kommentar blev minimeret af moderatoren på webstedet
Hej,


Hvad hvis jeg ville sende e-mailen baseret på, at ordet "fuldført" blev tilføjet til kolonne L?
Svar
0
0
krystal
krystal     Jesse
Denne kommentar blev minimeret af moderatoren på webstedet
Kære Jesse,
Følgende VBA-kode kan hjælpe dig med at løse problemet. Tak for din kommentar.

Privat Sub Worksheet_Change (ByVal Target As Range)
Hvis Target.Cells.Count > 1 Afslut Sub
Hvis (Ikke skærende(mål, rækkevidde("L:L")) er ingenting) og (mål.værdi = "fuldført"), så
Ring til Mail_small_Text_Outlook
End If
End Sub
Sub Mail_small_Text_Outlook()
Dim xOutApp som objekt
Dim xOutMail som objekt
Dim xMailBody As String
Indstil xOutApp = CreateObject("Outlook.Application")
Indstil xOutMail = xOutApp.CreateItem(0)
xMailBody = "Hej" & vbNewLine & vbNewLine & _
"Dette er linje 1" & vbNewLine & _
"Dette er linje 2"
On Error Resume Next
Med xOutMail
.To = "Din modtagers e-mailadresse"
.CC = ""
.BCC = ""
.Subject = "send med celleværditest"
.Body = xMailBody
.Vis 'eller brug .Send
Slut med
På Fejl GoTo 0
Indstil xOutMail = Ingenting
Indstil xOutApp = Ingenting
End Sub
Svar
Rapport
0
0
Jan
Jan
Denne kommentar blev minimeret af moderatoren på webstedet
Hej,
Jeg vil gerne have, at Outlook kun springer ud, når de data, jeg har indsat i Range ("D7:F7"), har mindst 1 nul eller et tomrum.
Jeg har fjernet linjen 'If Target.Cells.Count > 1 Then Exit Sub', og nu starter Outlook altid, når jeg indsætter en gruppe af værdier i cellerne D7:F7.

Hjælp.
Svar
0
0
krystal
krystal     Jan
Denne kommentar blev minimeret af moderatoren på webstedet
Kære Jan,
Følgende script kan hjælpe dig med at løse problemet. Tak for din kommentar.

Privat Sub Worksheet_Change (ByVal Target As Range)
Dim xOutApp som objekt
Dim xOutMail som objekt
Dim xMailBody As String
On Error Resume Next
Hvis Target.Address = Range("D7:F7"). Adresse derefter
Med Application.WorksheetFunction
Hvis .CountIf(Target, "") > 0 Eller .CountIf(Target, 0) > 0 Så
Indstil xOutApp = CreateObject("Outlook.Application")
Indstil xOutMail = xOutApp.CreateItem(0)
Med xOutMail
.To = "E-mail-adresse"
.CC = ""
.BCC = ""
.Subject = "send med celleværditest"
.Body = "Hej"
.Vis 'eller brug .Send
Slut med
På Fejl GoTo 0
Indstil xOutMail = Ingenting
Indstil xOutApp = Ingenting
End If
Slut med
End If
End Sub
Svar
Rapport
0
0
Noemi
Noemi
Denne kommentar blev minimeret af moderatoren på webstedet
Så jeg brugte din redigering til at inkludere et celleområde, men (hvis vi bruger regnearkseksemplet) tænkte jeg på, hvordan man tilføjer frugttypen, datoen og mængden i HTML-e-mailen fra regnearket, hvis de passer til kriterierne få en e-mail genereret. Så ville man sige

"Hej,"

Frugtnavn fra celle "Skal sættes på restordre, fordi pr. ordredato: " ordredato fra celle "vi har dette beløb:" mængde fra celle.
Svar
Rapport
0
0
krystal
krystal     Noemi
Denne kommentar blev minimeret af moderatoren på webstedet
Hej Noemi,
Prøv venligst dette VBA-script.

Privat Sub Worksheet_Change (ByVal Target As Range)
Dim xRg As Range
Dim I, J, K Så længe
Dim xOutApp som objekt
Dim xOutMail som objekt
Dim xMailBody As String
On Error Resume Next
Hvis Target.Address = Range("D7"). Adresse derefter
Med Application.WorksheetFunction
Hvis IsNumeric(Target.Value) Og Target.Value > 200, så
Indstil xRg = Application.InputBox("Vælg venligst det celleområde, du vil vise i mailens brødtekst：", "KuTools for Excel", Selection.Address, , , , , 8)
Hvis xRg ikke er noget, skal du afslutte Sub
For I = 1 Til xRg.Rows.Count
For J = 1 Til xRg.Rows(I).Columns.Count
For K = 1 Til xRg.Rækker(I).Kolonner(J).Tæller
xMailBody = xMailBody & " " & xRg.Rows(I).Columns(J).Cells(K).Text
Næste
Næste
xMailBody = xMailBody & vbNewLine
Næste
Indstil xOutApp = CreateObject("Outlook.Application")
Indstil xOutMail = xOutApp.CreateItem(0)
Med xOutMail
.To = "E-mail-adresse"
.CC = ""
.BCC = ""
.Subject = "send med celleværditest"
.Body = "Hej" & vbNewLine & xMailBody
.Vis 'eller brug .Send
Slut med
På Fejl GoTo 0
Indstil xOutMail = Ingenting
Indstil xOutApp = Ingenting
End If
Slut med
End If
End Sub
Svar
Rapport
0
0
Basha
Basha
Denne kommentar blev minimeret af moderatoren på webstedet
hej krystal
tak for dine koder, hvis det er muligt, send venligst koderne til nedenstående oplysninger

hvis vi har 8 til 9 coloums, der bruger forskellige typer udløb som pasudløbsdato, kørekortudløbsdato, køretøjsregistreringsudløbsdato, gatepassudløbsdato og mere osv., og mailadvarsel skal kun sendes til 5 givne personer.

ligesom vores datoblad er med mere end 300 ansatte, udløbs- og udløbsdato med i 15 dage i rød farve og e-mail-advarsel skal sendes.

gør venligst det nødvendige

tak på forhånd
Svar
0
0
krystal
krystal     Basha
Denne kommentar blev minimeret af moderatoren på webstedet
Hej,
Vi har postet en artikel "Hvordan sender man e-mail, hvis forfaldsdatoen er overholdt i Excel?"
Du kan se, om der er svar i denne artikel. Følg venligst dette link for at åbne artiklen: https://www.extendoffice.com/documents/excel/4664-excel-send-email-if-due-date-has-been-met.html
Tak.
Svar
Rapport
0
0
kevin b
kevin b
Denne kommentar blev minimeret af moderatoren på webstedet
Hej - Hvis jeg ville sende til en e-mail fra en liste i stedet for at sætte en egentlig e-mail-addy i koden, er det så muligt? tak
Svar
0
0
krystal
krystal     kevin b
Denne kommentar blev minimeret af moderatoren på webstedet
Hej,
Prøv venligst nedenfor VBA-kode, når den angivne celle opfylder betingelsen, vil en dialogboks poppe op, vælg venligst cellen, der indeholder den e-mail-adresse, du vil sende e-mail til. Håber det kan hjælpe. Tak skal du have.

Privat Sub Worksheet_Change (ByVal Target As Range)
Hvis Target.Cells.Count > 1 Afslut Sub
Indstil xRg = Range ("D7")
Hvis xRg = Target And Target.Value > 200 Så
Ring til Mail_small_Text_Outlook
End If
End Sub
Sub Mail_small_Text_Outlook()
Dim xOutApp som objekt
Dim xOutMail som objekt
Dim xMailBody As String
Dim xRgMsg As Range
Dim xCell As Range
Indstil xRgMsg = Application.InputBox("Vælg venligst adressecellerne：", "Kutools for Excel", , , , , , 8)
xMailBody = "Hej" & vbNewLine & vbNewLine & _
"Dette er linje 1" & vbNewLine & _
"Dette er linje 2"
On Error Resume Next
For hver xcelle i xRgMsg
Indstil xOutApp = CreateObject("Outlook.Application")
Indstil xOutMail = xOutApp.CreateItem(0)
Med xOutMail
.To = xCell.Value
.CC = ""
.BCC = ""
.Subject = "send med celleværditest"
.Body = xMailBody
.Vis 'eller brug .Send
Slut med
xOutApp = Intet
xOutMail = Intet
Næste
På Fejl GoTo 0
End Sub
Svar
Rapport
0
0
Der er endnu ingen kommentarer her
Load More
Efterlad dine kommentarer
Gæst
Sender som gæst
Login
×
Bedøm dette indlæg:
Nulstil
0   Tegn
Foreslåede steder

Følg os

Copyright © 2009 - www.extendoffice.com. | Alle rettigheder forbeholdes. Drevet af ExtendOffice. | | Sitemap
Microsoft og Office-logoet er varemærker eller registrerede varemærker tilhørende Microsoft Corporation i USA og / eller andre lande.
Beskyttet af Sectigo SSL