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

Cum să trimiteți automat e-mailuri pe baza valorii celulei din Excel?

Presupunând că doriți să trimiteți un e-mail prin Outlook unui anumit destinatar pe baza unei valori de celulă specificate în Excel. De exemplu, când valoarea celulei D7 într-o foaie de lucru este mai mare de 200, atunci se creează automat un e-mail. Acest articol introduce o metodă VBA pentru a rezolva rapid această problemă.

Trimiteți automat e-mail pe baza valorii celulei cu cod VBA


Trimiteți automat e-mail pe baza valorii celulei cu cod VBA

Vă rugăm să procedați după cum urmează pentru a trimite un e-mail pe baza valorii celulei din Excel.

1. În foaia de lucru trebuie să trimiteți e-mail pe baza valorii sale de celulă (aici spune celula D7), faceți clic dreapta pe fila foaie și selectați Afișați codul din meniul contextual. Vedeți captura de ecran:

2. În fereastra pop-up Microsoft Visual Basic pentru aplicații fereastra, vă rugăm să copiați și să lipiți codul VBA de mai jos în fereastra codului foii.

Cod VBA: trimiteți e-mail prin Outlook pe baza valorii celulei din 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

notițe:

1). În codul VBA, D7 și valoare> 200 sunt celula și valoarea celulei pe care veți trimite e-mail pe baza.
2). Vă rugăm să schimbați corpul e-mailului după cum aveți nevoie xMailBody linie în cod.
3). Înlocuiți adresa de e-mail cu adresa de e-mail a destinatarului în linie .To = "Adresă de e-mail".
4). Și specificați destinatarii Cc și Bcc după cum aveți nevoie .CC = „” și Cco = „” secțiuni.
5). În cele din urmă, schimbați subiectul e-mailului în rând .Subject = "trimite prin testul valorii celulei".

3. apasă pe Alt + Q tastele împreună pentru a închide Microsoft Visual Basic pentru aplicații fereastră.

De acum înainte, când valoarea pe care o introduceți în celula D7 este mai mare de 200, un mesaj de e-mail cu destinatarii și corpul specificați va fi creat automat în Outlook. Puteți face clic pe Trimitere pentru a trimite acest e-mail. Vedeți captura de ecran:

notițe:

1. Codul VBA funcționează numai atunci când utilizați Outlook ca program de e-mail.

2. Dacă datele introduse în celula D7 sunt o valoare text, va apărea și fereastra de e-mail.


Trimiteți ușor e-mail prin Outlook pe baza câmpurilor listei de discuții create în Excel:

Trimite emailuri utilitatea Kutools pentru Excel ajută utilizatorii să trimită e-mailuri prin Outlook pe baza listei de corespondență create în Excel.
Descărcați și încercați acum! (30- traseu liber de o zi)


Legate de articole:


Cele mai bune instrumente de productivitate Office

Kutools pentru Excel vă rezolvă majoritatea problemelor și vă crește productivitatea cu 80%

  • reutilizarea: Introduceți rapid formule complexe, diagrame și orice ai folosit anterior; Criptați celulele cu parola; Creați o listă de corespondență și trimiteți e-mailuri ...
  • Super Formula Bar (editați cu ușurință mai multe linii de text și formulă); Layout de citire (citiți și editați cu ușurință un număr mare de celule); Lipiți la interval filtrat...
  • Merge celule / rânduri / coloane fără a pierde date; Conținut de celule divizate; Combinați rânduri / coloane duplicate... Prevenirea celulelor duplicate; Comparați gamele...
  • Selectați Duplicat sau Unic Rânduri; Selectați Rânduri goale (toate celulele sunt goale); Super Find și Fuzzy Find în multe cărți de lucru; Selectare aleatorie ...
  • Copie exactă Mai multe celule fără modificarea referinței formulelor; Creați automat referințe la foi multiple; Introduceți gloanțe, Casete de selectare și multe altele ...
  • Extrageți textul, Adăugați text, eliminați după poziție, Eliminați spațiul; Creați și imprimați subtotaluri de paginare; Convertiți conținutul dintre celule și comentarii...
  • Super Filtru (salvați și aplicați scheme de filtrare altor foi); Sortare avansată după lună / săptămână / zi, frecvență și multe altele; Filtru special cu bold, italic ...
  • Combinați cărți de lucru și foi de lucru; Merge Tables pe baza coloanelor cheie; Împărțiți datele în mai multe foi; Conversia în loturi xls, xlsx și PDF...
  • Peste 300 de funcții puternice. Suportă Office / Excel 2007-2021 și 365. Acceptă toate limbile. Implementare ușoară în întreprinderea sau organizația dvs. Funcții complete Probă gratuită de 30 de zile. Garanție de returnare a banilor de 60 de zile.
fila kte 201905

Fila Office aduce interfața cu file în Office și vă face munca mult mai ușoară

  • Activați editarea și citirea cu file în Word, Excel, PowerPoint, Publisher, Access, Visio și Project.
  • Deschideți și creați mai multe documente în filele noi ale aceleiași ferestre, mai degrabă decât în ​​ferestrele noi.
  • Vă crește productivitatea cu 50% și reduce sute de clicuri de mouse pentru dvs. în fiecare zi!
fundul officetab
Comentarii (308)
Evaluat 5 din 5 · evaluări 1
Acest comentariu a fost redus la minimum de moderatorul de pe site
Cum ar trebui modificat codul pentru a se aplica unui întreg interval de celule?
Acest comentariu a fost redus la minimum de moderatorul de pe site
Dragă Debbie,
Vă rugăm să încercați mai jos codul VBA pentru a rezolva problema.

Subsol de lucrări private_Change (țintă ByVal ca rază de acțiune)
Dacă Target.Cells.Count > 1, apoi Ieșiți din sub
Dacă (Nu se intersectează(Target, Range("A1:D4"))) este Nimic) și (Target.Value > 200) atunci
Apelați Mail_small_Text_Outlook
Final, dacă
End Sub
Sub Mail_small_Text_Outlook()
Dim xOutApp ca obiect
Dim xOutMail ca obiect
Dim xMailBody ca șir
Setați xOutApp = CreateObject("Outlook.Application")
Setați xOutMail = xOutApp.CreateItem(0)
xMailBody = „Bună ziua” & vbNewLine & vbNewLine & _
„Aceasta este linia 1” & vbNewLine & _
„Aceasta este linia 2”
La data de eroare CV următoare
Cu xOutMail
.To = „Adresa de e-mail a destinatarului”
.CC = ""
.BCC = ""
.Subject = "trimite prin testul valorii celulei"
.Body = xMailBody
.Afișează sau folosește .Trimite
Se termina cu
La eroare GoTo 0
Setați xOutMail = Nimic
Setați xOutApp = Nimic
End Sub
Acest comentariu a fost redus la minimum de moderatorul de pe site
Întâmpin probleme în a obține acest cod să solicite dacă valoarea din celulă este schimbată indirect. De exemplu, dacă am ecuația Sum care schimbă automat această valoare. Când ecuația rulează și valoarea depășește valoarea setată pentru a solicita e-mailul, nu face acest lucru, decât dacă modific personal numărul. Există o modalitate de a face solicitarea prin e-mail chiar dacă a fost schimbată indirect?
Acest comentariu a fost redus la minimum de moderatorul de pe site
Dragă Iordania,
Următorul cod VBA vă poate ajuta să rezolvați problema. Vă rugăm să nu uitați să înlocuiți „Adresa de e-mail” cu adresa de e-mail a destinatarului în cod. Mulțumesc.

Subsol de lucrări private_Change (țintă ByVal ca rază de acțiune)
Dim xRgPre As Range
La data de eroare CV următoare
Dacă Target.Cells.Count > 1, apoi Ieșiți din sub
Setați xRg = Range ("D7")
Setați xRgPre = xRg.Precedente
Dacă xRg.Value > 200 Atunci
Dacă Target.Address = xRg.Address Atunci
Apelați Mail_small_Text_Outlook
ElseIf (Nu xRgPre este nimic) și (Intersect(Target, xRgPre).Address = Target.Address) Atunci
Apelați Mail_small_Text_Outlook
Final, dacă
Final, dacă
End Sub
Sub Mail_small_Text_Outlook()
Dim xOutApp ca obiect
Dim xOutMail ca obiect
Dim xMailBody ca șir
Setați xOutApp = CreateObject("Outlook.Application")
Setați xOutMail = xOutApp.CreateItem(0)
xMailBody = „Bună ziua” & vbNewLine & vbNewLine & _
„Aceasta este linia 1” & vbNewLine & _
„Aceasta este linia 2”
La data de eroare CV următoare
Cu xOutMail
.To = "Adresă de e-mail"
.CC = ""
.BCC = ""
.Subject = "trimite prin testul valorii celulei"
.Body = xMailBody
.Afișează sau folosește .Trimite
Se termina cu
La eroare GoTo 0
Setați xOutMail = Nimic
Setați xOutApp = Nimic
End Sub
Acest comentariu a fost redus la minimum de moderatorul de pe site
Am modificat codul sugerat pentru a încerca să îl fac să funcționeze pentru aplicația mea.
Modificat xRg = Range("C2:C40") și dacă xRg.Value = -1.

Problema pe care o întâmpin este că oricând există o schimbare în orice celulă și atâta timp cât una dintre celulele din intervalul meu este = -1, va apela Mail_small_Text_Outlook.
Încerc să sun numai dacă orice celulă din intervalul meu este schimbată indirect la -1.
De asemenea, mă întrebam dacă și cum ar fi posibil ca acesta să îndeplinească două criterii.
Ca verificați intervalul A și intervalul B și dacă îndeplinesc criteriile apelați funcția.

Multumesc anticipat pentru ajutor. Sunt nou în toate acestea, dar citind acest topic mă atrage aproximativ 90% acolo.


Subsol de lucrări private_Change (țintă ByVal ca rază de acțiune)
Dim xRgPre As Range
La data de eroare CV următoare
Dacă Target.Cells.Count > 1, apoi Ieșiți din sub
Setați xRg = Interval ("C2:C40")
Setați xRgPre = xRg.Precedente
Dacă xRg.Value = -1 Atunci
Dacă Target.Address = xRg.Address Atunci
Apelați Mail_small_Text_Outlook
ElseIf (Nu xRgPre este nimic) și (Intersect(Target, xRgPre).Address = Target.Address) Atunci
Apelați Mail_small_Text_Outlook
Final, dacă
Final, dacă
End Sub
Acest comentariu a fost redus la minimum de moderatorul de pe site
Am folosit acest cod, singura modificare fiind că l-am aplicat unei întregi coloane [Set xRg = Range("D4:D13")]. Acum, evenimentul se declanșează ori de câte ori se face un calcul, indiferent dacă supapa din coloana D este sub valoarea țintă. Ai idee de ce?


Dim Xrg As Range
Subsol de lucrări private_Change (țintă ByVal ca rază de acțiune)
Dim xRgPre As Range
La data de eroare CV următoare
Dacă Target.Cells.Count > 1, apoi Ieșiți din sub
Setați Xrg = Interval ("D4:D13")
Set xRgPre = Xrg.Precedents
Dacă Xrg.Value < 1200 Atunci
Dacă Target.Address = Xrg.Address Atunci
Apelați Mail_small_Text_Outlook
ElseIf (Nu xRgPre este nimic) și (Intersect(Target, xRgPre).Address = Target.Address) Atunci
Apelați Mail_small_Text_Outlook
Final, dacă
Final, dacă
End Sub

Sub Mail_small_Text_Outlook()
Dim xOutApp ca obiect
Dim xOutMail ca obiect
Dim xMailBody ca șir
Setați xOutApp = CreateObject("Outlook.Application")
Setați xOutMail = xOutApp.CreateItem(0)
xMailBody = „Bună” & vbNewLine & _
„Test vba” _
& vbNewLine & _
"Randul 2."
La data de eroare CV următoare
Cu xOutMail
.To = ""
.CC = ""
.BCC = ""
.Subject = „Test automat de e-mail”
.Body = xMailBody
.Afişa
Se termina cu
La eroare GoTo 0
Setați xOutMail = Nimic
Setați xOutApp = Nimic

End Sub


Multumesc.
Acest comentariu a fost redus la minimum de moderatorul de pe site
Hei

Am probleme deoarece destinatarul e-mailului trebuie adăugat din nou și din nou unul câte unul. Vă rugăm să indicați dacă lista de destinatari de e-mail poate fi adăugată la această funcție, astfel încât funcția să selecteze adresa de e-mail din lista de adrese de e-mail furnizată sau să încarce lista și funcția să trimită e-mailul, deja compus, către destinatarul dorit.
Acest comentariu a fost redus la minimum de moderatorul de pe site
Dragă Henry,
Următorul cod VBA vă poate ajuta să rezolvați problema. Vă rugăm să plasați scriptul VBA în modulul de foaie de lucru. Când valoarea din celula specificată îndeplinește condiția, va apărea o casetă de dialog Kutools for Excel, vă rugăm să selectați celulele care conțin adresele de e-mail ale destinatarilor și apoi faceți clic pe butonul OK. Apoi se deschid e-mailurile cu destinatarii specificați. Vă rugăm să le trimiteți după cum aveți nevoie.

Subsol de lucrări private_Change (țintă ByVal ca rază de acțiune)
Dacă Target.Cells.Count > 1, apoi Ieșiți din sub
Setați xRg = Range ("D7")
Dacă xRg = Țintă și țintă.Valoare > 200 Atunci
Apelați Mail_small_Text_Outlook
Final, dacă
End Sub
Sub Mail_small_Text_Outlook()
Dim xOutApp ca obiect
Dim xOutMail ca obiect
Dim xMailBody ca șir
Dim xRgMsg As Range
Dim xCell As Range
Set xRgMsg = Application.InputBox("Vă rugăm să selectați celulele adresei:", "Kutools pentru Excel", , , , , , 8)
xMailBody = „Bună ziua” & vbNewLine & vbNewLine & _
„Aceasta este linia 1” & vbNewLine & _
„Aceasta este linia 2”
La data de eroare CV următoare
Pentru fiecare xCell din xRgMsg
Setați xOutApp = CreateObject("Outlook.Application")
Setați xOutMail = xOutApp.CreateItem(0)
Cu xOutMail
.To = xCell.Value
.CC = ""
.BCC = ""
.Subject = "trimite prin testul valorii celulei"
.Body = xMailBody
.Afișează sau folosește .Trimite
Se termina cu
xOutApp = Nimic
xOutMail = Nimic
Pagina Următoare →
La eroare GoTo 0
End Sub
Acest comentariu a fost redus la minimum de moderatorul de pe site
va fi trimis automat prin poștă, fără nicio întrerupere manuală
Acest comentariu a fost redus la minimum de moderatorul de pe site
Dragă Brahma,
Dacă doriți să trimiteți direct e-mailul fără afișare, vă rugăm să înlocuiți rândul „.Display” cu „.Send” în codul VBA de mai sus.
Acest comentariu a fost redus la minimum de moderatorul de pe site
Bună, am pus același script, dar nu funcționează, vă rog să mă ajutați în prima parte

Dim xRg As Range

Subsol de lucrări private_Change (țintă ByVal ca rază de acțiune)
Dacă Target.Cells.Count > 1, apoi Ieșiți din sub
Setați xRg = Range ("D7")
Dacă xRg = țintă și țintă.Valoare = 200 Atunci
Apelați Mail_small_Text_Outlook
Final, dacă

End Sub
Acest comentariu a fost redus la minimum de moderatorul de pe site
Draga busuioc,
Există vreun avertisment la rularea codului?
Acest comentariu a fost redus la minimum de moderatorul de pe site
Bună ziua, cum ați modifica acest cod pentru a verifica dacă un grup de celule are șirul „Fără potrivire” și a trimite un e-mail dacă are.
Acest comentariu a fost redus la minimum de moderatorul de pe site
Dragă Jose,
Vă rugăm să încercați mai jos codul VBA. Când rulați codul, apare o casetă de dialog, selectați intervalul pe care îl veți verifica pentru șir și faceți clic pe butonul OK. dacă șirul nu există, veți primi o casetă de dialog prompt. Dacă șirul există în interval, se va afișa un e-mail cu destinatarul, subiectul și corpul specificat.

Sub Trimite e-mail()
Dim I As Long
Dim J As Long
Dim xRg As Range
Dim xArr
Dim xOutApp ca obiect
Dim xOutMail ca obiect
Dim xMailBody ca șir
Dim xFlag ca boolean
La data de eroare CV următoare
Set xRg = Application.InputBox(„Vă rugăm să selectați intervalul”, „Kutools pentru Excel”, Selection.Address, , , , , 8)
Dacă xRg nu este nimic, ieșiți din sub
xArr = xRg.Valoare
xFlag = Fals
Pentru I = 1 La UBound(xArr)
Pentru J = 1 La UBound(xArr, 2)
Dacă xArr(I, J) = „Fără potrivire” atunci
xFlag = Adevărat
Final, dacă
Pagina Următoare →
Pagina Următoare →
Dacă xFlag Atunci
Setați xOutApp = CreateObject("Outlook.Application")
Setați xOutMail = xOutApp.CreateItem(0)
xMailBody = „Bună ziua” & vbNewLine & vbNewLine & _
„Aceasta este linia 1” & vbNewLine & _
„Aceasta este linia 2”
Cu xOutMail
.To = „Adresă de e-mail”
.CC = ""
.BCC = ""
.Subiect = „Potrivire”
.Body = xMailBody
.Afișează sau folosește .Trimite
Se termina cu
Altfel
MsgBox „Nu a fost găsită nicio valoare potrivită”, vbInformation, „KuTools pentru Excel”
Final, dacă
End Sub
Acest comentariu a fost redus la minimum de moderatorul de pe site
Cum aș putea schimba acest cod pentru trimiterea notelor elevilor către părinți. Unde dacă coloana A este nota și coloana B este e-mailul părintelui. Vreau să completez un e-mail pentru fiecare student cu un F ca notă.
Acest comentariu a fost redus la minimum de moderatorul de pe site
Dragă Frank,
Codul VBA de mai jos vă poate ajuta să rezolvați problema. Mulțumesc.

Sub Mail_small_Text_Outlook()
Dim xRg As Range
Dim I As Long
Dim xRows As Long
Dim xVal As String
Dim xOutApp ca obiect
Dim xOutMail ca obiect
Dim xMailBody ca șir
La data de eroare CV următoare
Set xRg = Application.InputBox(„Vă rugăm să selectați coloana de calificare și coloana de e-mail (două coloane)”, „Kutools pentru Excel”, Selection.Address, , , , , 8)
Dacă xRg nu este nimic, ieșiți din sub
xRows = xRg.Rows.Count
Setați xRg = xRg(2)
Pentru I = 1 To xRows
xVal = xRg.Offset(I, -1).Text
Dacă xVal = "F" atunci
Setați xOutApp = CreateObject("Outlook.Application")
Setați xOutMail = xOutApp.CreateItem(0)
xMailBody = „Bună ziua” & vbNewLine & vbNewLine & _
„Aceasta este nota copilului dumneavoastră” & xRg.Offset(I, -1).Text
Cu xOutMail
.to = xRg.Offset(I, 0).Text
.Subject = "trimite prin testul valorii celulei"
.Body = xMailBody
.Afișează sau folosește .Trimite
Se termina cu
La eroare GoTo 0
Setați xOutMail = Nimic
Setați xOutApp = Nimic
Final, dacă
Pagina Următoare →
End Sub
Acest comentariu a fost redus la minimum de moderatorul de pe site
Am deja o listă de adrese de e-mail într-un fișier excel, cum pot modifica codul pentru a alege automat adresa de e-mail a persoanei dacă celula sa D7 este >200?
Acest comentariu a fost redus la minimum de moderatorul de pe site
O zi buna,
Următorul cod VBA vă poate ajuta să rezolvați problema. Vă rugăm să plasați scriptul VBA în modulul de foaie de lucru. Când valoarea din celula specificată îndeplinește condiția, va apărea o casetă de dialog Kutools for Excel, vă rugăm să selectați celulele care conțin adresele de e-mail ale destinatarilor și apoi faceți clic pe butonul OK. Apoi se deschid e-mailurile cu destinatarii specificați. Vă rugăm să le trimiteți după cum aveți nevoie.

Subsol de lucrări private_Change (țintă ByVal ca rază de acțiune)
Dacă Target.Cells.Count > 1, apoi Ieșiți din sub
Setați xRg = Range ("D7")
Dacă xRg = Țintă și țintă.Valoare > 200 Atunci
Apelați Mail_small_Text_Outlook
Final, dacă
End Sub
Sub Mail_small_Text_Outlook()
Dim xOutApp ca obiect
Dim xOutMail ca obiect
Dim xMailBody ca șir
Dim xRgMsg As Range
Dim xCell As Range
Set xRgMsg = Application.InputBox("Vă rugăm să selectați celulele adresei:", "Kutools pentru Excel", , , , , , 8)
xMailBody = „Bună ziua” & vbNewLine & vbNewLine & _
„Aceasta este linia 1” & vbNewLine & _
„Aceasta este linia 2”
La data de eroare CV următoare
Pentru fiecare xCell din xRgMsg
Setați xOutApp = CreateObject("Outlook.Application")
Setați xOutMail = xOutApp.CreateItem(0)
Cu xOutMail
.To = xCell.Value
.CC = ""
.BCC = ""
.Subject = "trimite prin testul valorii celulei"
.Body = xMailBody
.Afișează sau folosește .Trimite
Se termina cu
xOutApp = Nimic
xOutMail = Nimic
Pagina Următoare →
La eroare GoTo 0
End Sub
Acest comentariu a fost redus la minimum de moderatorul de pe site
Am probleme la trimiterea e-mailurilor prin Outlook. Primesc eroarea care spune „Un program încearcă să trimită un e-mail în numele dvs. Dacă este neașteptat, vă rugăm să refuzați și să verificați că software-ul antivirus este actualizat”
Vă rugăm să ajutați, deoarece nu pot să-l automatizez.
Acest comentariu a fost redus la minimum de moderatorul de pe site
Îmi pare rău Mayank,
Codul funcționează bine în cazul meu. Se pare că ceva despre funcția „trimite în numele” este configurat în Outlook. Vă rugăm să verificați.
Acest comentariu a fost redus la minimum de moderatorul de pe site
Bună ziua, ce cod aș folosi dacă încerc să trimit un e-mail unui manager care are o listă cu fructele care au o cantitate > 200 o dată pe lună (pe baza exemplului dvs.) sau expiră în curând (pe baza datelor)
Acest comentariu a fost redus la minimum de moderatorul de pe site
Good Day
Poate fi metoda din acest articol „Cum se trimit e-mail dacă data scadentă a fost respectată în Excel?” vă poate ajuta.
Vă rugăm să urmați acest link: https://www.extendoffice.com/documents/excel/4664-excel-send-email-if-due-date-has-been-met.html
Acest comentariu a fost redus la minimum de moderatorul de pe site
Cum pot edita codul pentru a trimite un e-mail pe baza unei date din celulă. De exemplu, am nevoie de un document revizuit la fiecare 15 luni și vreau să renunț la un e-mail la 12 luni la o adresă de e-mail care spune că documentul trebuie revizuit. Am apucat să trimit automat un e-mail schimbând .Display în .Send și funcționează excelent așa cum este scris, dar ce trebuie să schimb pentru a folosi o funcție de dată în loc de un număr întreg?
Acest comentariu a fost redus la minimum de moderatorul de pe site
Cum puteți adăuga un interval multiplu la „Set xRg = Range ("D7")? Vreau să-l editez și să adaug Range ("D7:F7"). Totuși, primesc o eroare de Run Time Error 13, Type Mismatch și mă duce la If xRg = Target And Target.Value > 2 Then.


Cum pot rezolva această problemă?
Acest comentariu a fost redus la minimum de moderatorul de pe site
O zi buna,
Vă rugăm să încercați mai jos codul VBA pentru a rezolva problema.

Subsol de lucrări private_Change (țintă ByVal ca rază de acțiune)
Dacă Target.Cells.Count > 1, apoi Ieșiți din sub
Dacă (Nu se intersectează(Target, Range("D7:F7")) nu este nimic) și (Target.Value > 200) atunci
Apelați Mail_small_Text_Outlook
Final, dacă
End Sub
Sub Mail_small_Text_Outlook()
Dim xOutApp ca obiect
Dim xOutMail ca obiect
Dim xMailBody ca șir
Setați xOutApp = CreateObject("Outlook.Application")
Setați xOutMail = xOutApp.CreateItem(0)
xMailBody = „Bună ziua” & vbNewLine & vbNewLine & _
„Aceasta este linia 1” & vbNewLine & _
„Aceasta este linia 2”
La data de eroare CV următoare
Cu xOutMail
.To = „Adresa de e-mail a destinatarului”
.CC = ""
.BCC = ""
.Subject = "trimite prin testul valorii celulei"
.Body = xMailBody
.Afișează sau folosește .Trimite
Se termina cu
La eroare GoTo 0
Setați xOutMail = Nimic
Setați xOutApp = Nimic
End Sub
Acest comentariu a fost redus la minimum de moderatorul de pe site
a funcționat perfect.. Mulțumesc..:):)
Acest comentariu a fost redus la minimum de moderatorul de pe site
Nu funcționează pentru mine, deoarece valoarea din D7 este rezultatul unui formular. Ce se întâmplă dacă celula D7 conține o formulă, de exemplu D7 =2*120? Încă îndeplinește condiția, dar nu se întâmplă nimic. Te rog ajuta-ma
Acest comentariu a fost redus la minimum de moderatorul de pe site
cum să opriți rularea codului, adică să nu solicitați e-mailul atunci când condiția nu este îndeplinită?

chiar și atunci când D7 < 200, tot mi se solicită e-mailul.
Acest comentariu a fost redus la minimum de moderatorul de pe site
O zi buna,
Codul este actualizat în postare cu problema rezolvată. Multumesc pentru comentariu.
Acest comentariu a fost redus la minimum de moderatorul de pe site
Hi

Vă mulțumesc foarte mult pentru postarea acestui cod VBA și instrucțiuni. Când l-am găsit, am simțit că am câștigat la loto. Cu toate acestea, sunt blocat cu ceva, așa că sper că mă puteți ajuta (sunt nou în VBA, am doar cunoștințe de bază).

Am copiat codul și am schimbat celula și valoarea celulei pentru a alege dintr-un interval dacă este îndeplinit un criteriu. Am încercat și testat și funcționează și am primit un e-mail la Outlook pe baza criteriilor.

1) Cu toate acestea, nu pot să-mi dau seama cum să fac ca codul VBA să ruleze automat atunci când deschid foaia de lucru Excel, în loc să trebuiască să dau clic pe aplicația VBA și să selectez Run. Ați putea să ne sfătuiți dacă există o solicitare suplimentară pentru a introduce codul VBA de mai sus care va face acest lucru sau trebuie făcută separat.

2) Există, de asemenea, o modalitate de a obține codul VBA pentru a trimite un e-mail unei persoane dacă data scadentă este da pentru un anumit articol, așa cum se arată în exemplul de mai jos.
e-mail coloană ascunsă
Nume si Prenume

Procedură
Procedura nr.1 scadenta da
Procedura nr. 2 scadenta nr

Aș avea mulți oameni în foaia de calcul (care trec pe orizontală într-un rând) și „Da” ar putea fi evidențiat pentru diferite proceduri restante (enumerate vertical în coloana A. Există o modalitate de a crea un cod VBA care rulează pentru așa ceva - dacă „Da” pentru „Persoana 1”, atunci trimiteți prin e-mail „persoana 1” cu „numărul procedurii #” (sau numerele) și data(le) scadentă. Fiind capabil să enumerați în e-mail toate procedurile și datele scadente ulterioare.

Nu m-ar deranja dacă ar trebui să setez un cod VBA separat pentru fiecare persoană, atâta timp cât acesta trimite un e-mail cu toate documentele restante pentru persoana respectivă și datele scadente.

În speranța că poți ajuta
Acest comentariu a fost redus la minimum de moderatorul de pe site
Dragă Ann,
Vă rugăm să încercați codul VBA de mai jos. Multumesc pentru comentariu.

Sub Mail_small_Text_Outlook()
Dim xRg As Range
Dim xCell As Range
Dim I As Long
Dim xRows As Long
Dim xCols As Long
Dim xVal As String
Dim xOutApp ca obiect
Dim xOutMail ca obiect
Dim xMailBody ca șir
La data de eroare CV următoare
Set xRg = Application.InputBox(„Selectați intervalul care conține valoarea celulei pe care o veți trimite e-mailuri pe baza:”, „Kutools for Excel”, Selection.Address, , , , , 8)
Dacă xRg nu este nimic, ieșiți din sub
xRows = xRg.Rows.Count
xCols = xRg.Columns.Count
Pentru I = 1 To xRows
Set xCell = xRg(I, xCols)
Dacă xCell.Value = „Da”, atunci
Setați xOutApp = CreateObject("Outlook.Application")
Setați xOutMail = xOutApp.CreateItem(0)
xMailBody = „Bună ziua” & vbNewLine & vbNewLine & _
"Aceasta sunt informațiile dvs.: " & vbNewLine & xCell.Offset(0, -1).Text & vbNewLine & xCell.Offset(0, -2).Text
Cu xOutMail
.To = xCell.Offset(0, -4).Text
.Subject = "trimite prin testul valorii celulei"
.Body = xMailBody
.Afișează sau folosește .Trimite
Se termina cu
La eroare GoTo 0
Setați xOutMail = Nimic
Setați xOutApp = Nimic
Final, dacă
Pagina Următoare →
End Sub
Acest comentariu a fost redus la minimum de moderatorul de pe site
Cristal,

Acesta înlocuiește următorul cod:

Sub-e-mail()

Dim xRg As Range

Dim xRgEach As Range

Dim xEmail_Subject, xEmail_Send_Form,;etc.
Acest comentariu a fost redus la minimum de moderatorul de pe site
Unde mai exact introducem acest cod?
Acest comentariu a fost redus la minimum de moderatorul de pe site
Bună ziua,
Trebuie să plasați codul în fereastra de cod a foii de lucru.
Deschideți fereastra Microsoft Visual Basic pentru aplicații, faceți dublu clic pe numele foii din panoul din stânga pentru a deschide editorul de cod.
Acest comentariu a fost redus la minimum de moderatorul de pe site
Salut,


În prezent, întâmpin puține probleme cu codarea (nou în asta - poate că am mușcat mai mult decât pot mesteca)


În prezent, am o foaie de calcul cu următoarele căreia am nevoie de ajutor pentru a automatiza și a trimite e-mailuri pentru defecțiuni care se află la proprietățile noastre pentru afacerea noastră


În prezent, am nevoie de un cod care să folosească următoarele date:


1) O adresă și problema ( 2 celule "generale" care au fost îmbinate prin ((În celula D1)) " = =CONCAT(B1," "C1,) "
Adresa din B1 va fi întotdeauna aceeași (mai mult sau mai puțin)
În timp ce C1 se va schimba întotdeauna în funcție de defecțiunea proprietății.


2) Un e-mail care urmează să fie trimis prin aceeași adresă de e-mail, (pot folosi $E$1 sau trebuie să folosesc E1 - E1. de exemplu) sau pot introduce doar „TheEmailAdress@.co.uk” în linia de cod


3) Corpul e-mailului să fie populat în mod similar cu punctul 1) ...... ((În celula F1)) " =CONCAT(G1," ",H1)
Acestea se vor schimba constant, deoarece reprezintă compania (G1) și ceea ce fac, repară, cotează etc. (H1)

4) Declanșatorul pentru a trimite e-mail-ul, aș fi numărul 7, foaia este actualizată zilnic (7 zile într-o săptămână)
ca atare am nevoie de declanșatorul pentru a trimite e-mailul în ziua 7, dar nu în mod constant ca în ziua 8, 9, 10+ etc. și nu înainte, cum ar fi 1-6, acesta ar fi în A4: A 100+ (deoarece ne extindem constant


4) Am folosit fragmente mici de la alți utilizatori care au menționat despre utilizarea unei liste pentru declanșatorul pentru a trimite e-mailul, dar nu sunt sigur că a fost 100% corect, dar mi-ar trebui să o scanez deși toate Collum A... A4: A100
iar dacă există 47 de celule care conțin doar „7” atunci vor fi trimise 47 de e-mailuri


Vă mulțumesc pentru că ați citit și sper că mă puteți ajuta :)
Acest comentariu a fost redus la minimum de moderatorul de pe site
Dragă martin,
Îmi pare rău, nu te pot ajuta cu asta.
Puteți posta întrebarea dvs. pe forumul nostru: https://www.extendoffice.com/forum.html pentru a obține mai multe suporturi Excel de la personalul nostru tehnic.
Multumesc pentru comentariu.

Salutari,
Cristal
Acest comentariu a fost redus la minimum de moderatorul de pe site
Bună,


Ce se întâmplă dacă aș vrea să trimit e-mailul pe baza cuvântului „finalizat” adăugat în coloana L?
Acest comentariu a fost redus la minimum de moderatorul de pe site
Dragă Jesse,
Următorul cod VBA vă poate ajuta să rezolvați problema. Multumesc pentru comentariu.

Subsol de lucrări private_Change (țintă ByVal ca rază de acțiune)
Dacă Target.Cells.Count > 1, apoi Ieșiți din sub
Dacă (Nu se intersectează(Target, Range("L:L"))) este Nimic) și (Target.Value = "finalizat"), atunci
Apelați Mail_small_Text_Outlook
Final, dacă
End Sub
Sub Mail_small_Text_Outlook()
Dim xOutApp ca obiect
Dim xOutMail ca obiect
Dim xMailBody ca șir
Setați xOutApp = CreateObject("Outlook.Application")
Setați xOutMail = xOutApp.CreateItem(0)
xMailBody = „Bună ziua” & vbNewLine & vbNewLine & _
„Aceasta este linia 1” & vbNewLine & _
„Aceasta este linia 2”
La data de eroare CV următoare
Cu xOutMail
.To = „Adresa de e-mail a destinatarului”
.CC = ""
.BCC = ""
.Subject = "trimite prin testul valorii celulei"
.Body = xMailBody
.Afișează sau folosește .Trimite
Se termina cu
La eroare GoTo 0
Setați xOutMail = Nimic
Setați xOutApp = Nimic
End Sub
Acest comentariu a fost redus la minimum de moderatorul de pe site
Bună,
Aș dori ca Outlook să apară numai atunci când datele pe care le-am lipit în Interval ("D7:F7") au cel puțin 1 zero sau un gol.
Am eliminat linia „Dacă Target.Cells.Count > 1 Then Exit Sub”, iar acum Outlook se lansează întotdeauna când lipesc orice grup de valori în celulele D7:F7.

Ajutor.
Acest comentariu a fost redus la minimum de moderatorul de pe site
Dragă Jan,
Următorul script vă poate ajuta să rezolvați problema. Multumesc pentru comentariu.

Subsol de lucrări private_Change (țintă ByVal ca rază de acțiune)
Dim xOutApp ca obiect
Dim xOutMail ca obiect
Dim xMailBody ca șir
La data de eroare CV următoare
Dacă Target.Address = Range("D7:F7").Adresa Atunci
Cu Application.WorksheetFunction
Dacă .CountIf(Target, "") > 0 Sau .CountIf(Target, 0) > 0 Atunci
Setați xOutApp = CreateObject("Outlook.Application")
Setați xOutMail = xOutApp.CreateItem(0)
Cu xOutMail
.To = "Adresă de e-mail"
.CC = ""
.BCC = ""
.Subject = "trimite prin testul valorii celulei"
.Body = „Bună ziua”
.Afișează sau folosește .Trimite
Se termina cu
La eroare GoTo 0
Setați xOutMail = Nimic
Setați xOutApp = Nimic
Final, dacă
Se termina cu
Final, dacă
End Sub
Acest comentariu a fost redus la minimum de moderatorul de pe site
Așa că am folosit editarea dvs. pentru a include un interval de celule, dar (dacă folosim exemplul foii de lucru) mă întrebam cum să adăugați tipul de fructe, data și cantitatea în e-mailul HTML din foaia de lucru dacă se potrivesc criteriilor pentru au generat un e-mail. Așa s-ar spune

"Bună,"

Numele fructelor din celulă „Trebuie să fie pus la comandă din urmă, deoarece la data comenzii: „ data comenzii din celulă „avem această cantitate:” cantitate din celulă.
Acest comentariu a fost redus la minimum de moderatorul de pe site
Salut Noemi,
Vă rugăm să încercați acest script VBA.

Subsol de lucrări private_Change (țintă ByVal ca rază de acțiune)
Dim xRg As Range
Dim I, J, K As Long
Dim xOutApp ca obiect
Dim xOutMail ca obiect
Dim xMailBody ca șir
La data de eroare CV următoare
Dacă Target.Address = Range("D7").Address Atunci
Cu Application.WorksheetFunction
Dacă IsNumeric(Target.Value) și Target.Value > 200, atunci
Set xRg = Application.InputBox("Vă rugăm să selectați intervalul de celule pe care îl veți afișa în corpul e-mailului:", "KuTools for Excel", Selection.Address, , , , , 8)
Dacă xRg nu este nimic, ieșiți din sub
Pentru I = 1 To xRg.Rows.Count
Pentru J = 1 To xRg.Rows(I).Columns.Count
Pentru K = 1 To xRg.Rows(I).Columns(J).Count
xMailBody = xMailBody & " " & xRg.Rows(I).Columns(J).Cells(K).Text
Pagina Următoare →
Pagina Următoare →
xMailBody = xMailBody & vbNewLine
Pagina Următoare →
Setați xOutApp = CreateObject("Outlook.Application")
Setați xOutMail = xOutApp.CreateItem(0)
Cu xOutMail
.To = "Adresă de e-mail"
.CC = ""
.BCC = ""
.Subject = "trimite prin testul valorii celulei"
.Body = "Bună ziua" & vbNewLine & xMailBody
.Afișează sau folosește .Trimite
Se termina cu
La eroare GoTo 0
Setați xOutMail = Nimic
Setați xOutApp = Nimic
Final, dacă
Se termina cu
Final, dacă
End Sub
Acest comentariu a fost redus la minimum de moderatorul de pe site
salut cristal
Vă mulțumim pentru codurile dvs., dacă este posibil, vă rugăm să trimiteți codurile pentru detaliile de mai jos

dacă avem 8 până la 9 coloane folosind diferite tipuri de expirări, cum ar fi data de expirare a pașaportului, data de expirare a permisului de conducere, data de expirare a înmatriculării vehiculului, data de expirare a permisului de poartă și multe altele, și alerta prin e-mail trebuie trimisă doar la 5 persoane date.

La fel ca fișa noastră de date este cu mai mult de 300 de angajați, data expirată și de expirare cu în 15 zile în culoare roșie și alerta prin e-mail ar trebui trimisă.

faceți cu amabilitate ceea ce este necesar

Multumesc anticipat
Acest comentariu a fost redus la minimum de moderatorul de pe site
Buna,
Am postat un articol „Cum se trimite e-mail dacă data scadentă a fost respectată în Excel?”
Puteți vedea dacă există răspunsuri în acest articol. Urmați acest link pentru a deschide articolul: https://www.extendoffice.com/documents/excel/4664-excel-send-email-if-due-date-has-been-met.html
Mulțumesc.
Acest comentariu a fost redus la minimum de moderatorul de pe site
Bună ziua- Dacă aș vrea să trimit la un e-mail dintr-o listă în loc să pun în cod un e-mail real, este posibil? Mulțumiri
Acest comentariu a fost redus la minimum de moderatorul de pe site
Buna,
Vă rugăm să încercați mai jos codul VBA, când celula specificată îndeplinește condiția, va apărea un dialog, vă rugăm să selectați celula care conține adresa de e-mail la care veți trimite e-mail. Sper că poate ajuta. Mulțumesc.

Subsol de lucrări private_Change (țintă ByVal ca rază de acțiune)
Dacă Target.Cells.Count > 1, apoi Ieșiți din sub
Setați xRg = Range ("D7")
Dacă xRg = Țintă și țintă.Valoare > 200 Atunci
Apelați Mail_small_Text_Outlook
Final, dacă
End Sub
Sub Mail_small_Text_Outlook()
Dim xOutApp ca obiect
Dim xOutMail ca obiect
Dim xMailBody ca șir
Dim xRgMsg As Range
Dim xCell As Range
Set xRgMsg = Application.InputBox("Vă rugăm să selectați celulele adresei:", "Kutools pentru Excel", , , , , , 8)
xMailBody = „Bună ziua” & vbNewLine & vbNewLine & _
„Aceasta este linia 1” & vbNewLine & _
„Aceasta este linia 2”
La data de eroare CV următoare
Pentru fiecare xCell din xRgMsg
Setați xOutApp = CreateObject("Outlook.Application")
Setați xOutMail = xOutApp.CreateItem(0)
Cu xOutMail
.To = xCell.Value
.CC = ""
.BCC = ""
.Subject = "trimite prin testul valorii celulei"
.Body = xMailBody
.Afișează sau folosește .Trimite
Se termina cu
xOutApp = Nimic
xOutMail = Nimic
Pagina Următoare →
La eroare GoTo 0
End Sub
Nu există comentarii postate aici încă
Încărcați mai
Lăsa comentarii
Postare ca invitat
×
Evaluează această postare:
0   Caractere
Locații sugerate

Urmărește-ne

Copyright © 2009 - www.extendoffice.com. | Toate drepturile rezervate. Cu sprijinul ExtendOffice. | Harta site-ului
Microsoft și sigla Office sunt mărci comerciale sau mărci comerciale înregistrate ale Microsoft Corporation în Statele Unite și / sau în alte țări.
Protejat de Sectigo SSL