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

Πώς να στέλνετε αυτόματα email με βάση την τιμή κελιού στο Excel;

Ας υποθέσουμε ότι θέλετε να στείλετε ένα email μέσω του Outlook σε έναν συγκεκριμένο παραλήπτη με βάση μια καθορισμένη τιμή κελιού στο Excel. Για παράδειγμα, όταν η τιμή του κελιού D7 σε ένα φύλλο εργασίας είναι μεγαλύτερη από 200, τότε δημιουργείται αυτόματα ένα μήνυμα ηλεκτρονικού ταχυδρομείου. Αυτό το άρθρο παρουσιάζει μια μέθοδο VBA για να επιλύσετε γρήγορα αυτό το ζήτημα.

Αυτόματη αποστολή email με βάση την τιμή κελιού με τον κωδικό VBA


Αυτόματη αποστολή email με βάση την τιμή κελιού με τον κωδικό VBA

Κάντε τα εξής για να στείλετε ένα email με βάση την τιμή κελιού στο Excel.

1. Στο φύλλο εργασίας πρέπει να στείλετε email με βάση την τιμή κελιού του (εδώ λέει το κελί D7), κάντε δεξί κλικ στην καρτέλα φύλλου και Προβολή κωδικού από το μενού περιβάλλοντος. Δείτε το στιγμιότυπο οθόνης:

2. Στο αναδυόμενο παράθυρο Microsoft Visual Basic για εφαρμογές παράθυρο, αντιγράψτε και επικολλήστε τον παρακάτω κώδικα VBA στο παράθυρο του κωδικού φύλλου.

Κωδικός VBA: Αποστολή email μέσω του Outlook με βάση την τιμή κελιού στο 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

Notes:

1). Στον κώδικα VBA, D7 και τιμή> 200 είναι η τιμή κελιού και κυψέλης στην οποία θα στείλετε email.
2). Αλλάξτε το σώμα του email όπως χρειάζεστε xMailBody γραμμή στον κώδικα.
3). Αντικαταστήστε τη διεύθυνση email με τη διεύθυνση email του παραλήπτη στη γραμμή .To = "Διεύθυνση ηλεκτρονικού ταχυδρομείου".
4). Και καθορίστε τους παραλήπτες Κοιν. και Κρυφή κοιν. όπως χρειάζεστε .CC = "" και Bcc = "" ενότητες.
5). Τέλος αλλάξτε το θέμα του email στη σειρά .Θέμα = "αποστολή με δοκιμή τιμής κελιού".

3. Πάτα το άλλος + Q πλήκτρα μαζί για να κλείσετε το Microsoft Visual Basic για εφαρμογές παράθυρο.

Στο εξής, όταν η τιμή που εισάγετε στο κελί D7 είναι μεγαλύτερη από 200, θα δημιουργηθεί αυτόματα ένα μήνυμα ηλεκτρονικού ταχυδρομείου με καθορισμένους παραλήπτες και σώμα στο Outlook. Μπορείτε να κάνετε κλικ στο Στείλετε κουμπί για να στείλετε αυτό το email. Δείτε το στιγμιότυπο οθόνης:

Notes:

1. Ο κωδικός VBA λειτουργεί μόνο όταν χρησιμοποιείτε το Outlook ως πρόγραμμα ηλεκτρονικού ταχυδρομείου.

2. Εάν τα δεδομένα που έχουν εισαχθεί στο κελί D7 είναι τιμή κειμένου, θα εμφανιστεί επίσης το παράθυρο email.


Στείλτε εύκολα email μέσω του Outlook με βάση τα πεδία της δημιουργημένης λίστας αλληλογραφίας στο Excel:

Η καλύτερη Αποστολή email χρησιμότητα του Kutools για Excel βοηθά τους χρήστες να στέλνουν email μέσω του Outlook με βάση τη λίστα αλληλογραφίας που δημιουργήθηκε στο Excel
Κατεβάστε και δοκιμάστε το τώρα! (Δωρεάν μονοπάτι 30 ημερών)


Σχετικά άρθρα:


Τα καλύτερα εργαλεία παραγωγικότητας του Office

Το Kutools για Excel λύνει τα περισσότερα από τα προβλήματά σας και αυξάνει την παραγωγικότητά σας κατά 80%

  • Επαναχρησιμοποίηση: Εισαγάγετε γρήγορα σύνθετοι τύποι, γραφήματα και οτιδήποτε έχετε χρησιμοποιήσει στο παρελθόν. Κρυπτογράφηση κυττάρων με κωδικό πρόσβασης Δημιουργία λίστας αλληλογραφίας και στείλτε email ...
  • Super Formula Bar (επεξεργαστείτε εύκολα πολλές γραμμές κειμένου και τύπου). Διάταξη ανάγνωσης (εύκολη ανάγνωση και επεξεργασία μεγάλου αριθμού κελιών). Επικόλληση σε φιλτραρισμένο εύρος...
  • Συγχώνευση κελιών / σειρών / στηλών χωρίς απώλεια δεδομένων · Περιεχόμενο διαχωρισμού κελιών Συνδυάστε διπλές σειρές / στήλες... Αποτροπή διπλών κυττάρων; Συγκρίνετε τα εύρη...
  • Επιλέξτε Διπλότυπο ή Μοναδικό Σειρές; Επιλέξτε Κενές σειρές (όλα τα κελιά είναι κενά). Σούπερ εύρεση και ασαφής εύρεση σε πολλά βιβλία εργασίας. Τυχαία επιλογή ...
  • Ακριβές αντίγραφο Πολλαπλά κελιά χωρίς αλλαγή της αναφοράς τύπου. Αυτόματη δημιουργία αναφορών σε πολλαπλά φύλλα? Εισαγωγή κουκκίδων, Πλαίσια ελέγχου και άλλα ...
  • Εξαγωγή κειμένου, Προσθήκη κειμένου, Κατάργηση κατά θέση, Αφαιρέστε το διάστημα; Δημιουργία και εκτύπωση υποσύνολων σελιδοποίησης. Μετατροπή περιεχομένου και σχολίων μεταξύ κελιών...
  • Σούπερ φίλτρο (αποθηκεύστε και εφαρμόστε σχήματα φίλτρων σε άλλα φύλλα). Προηγμένη ταξινόμηση ανά μήνα / εβδομάδα / ημέρα, συχνότητα και άλλα. Ειδικό φίλτρο με έντονη, πλάγια ...
  • Συνδυάστε βιβλία εργασίας και φύλλα εργασίας; Συγχώνευση πινάκων βάσει βασικών στηλών. Διαχωρίστε τα δεδομένα σε πολλά φύλλα; Μαζική μετατροπή xls, xlsx και PDF...
  • Περισσότερα από 300 ισχυρά χαρακτηριστικά. Υποστηρίζει Office / Excel 2007-2019 και 365. Υποστηρίζει όλες τις γλώσσες. Εύκολη ανάπτυξη στην επιχείρηση ή τον οργανισμό σας. Πλήρεις δυνατότητες δωρεάν δοκιμής 30 ημερών. Εγγύηση επιστροφής χρημάτων 60 ημερών.
kte καρτέλα 201905

Το Office Tab φέρνει τη διεπαφή με καρτέλες στο Office και κάνει την εργασία σας πολύ πιο εύκολη

  • Ενεργοποίηση επεξεργασίας και ανάγνωσης καρτελών σε Word, Excel, PowerPoint, Publisher, Access, Visio και Project.
  • Ανοίξτε και δημιουργήστε πολλά έγγραφα σε νέες καρτέλες του ίδιου παραθύρου και όχι σε νέα παράθυρα.
  • Αυξάνει την παραγωγικότητά σας κατά 50% και μειώνει εκατοντάδες κλικ ποντικιού για εσάς κάθε μέρα!
κάτω μέρος γραφείου
Σχόλια (290)
Δεν υπάρχουν ακόμη βαθμολογίες. Γίνε ο πρώτος που θα αξιολογήσετε!
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Πώς πρέπει να τροποποιηθεί ο κώδικας, ώστε να εφαρμόζεται σε μια ολόκληρη σειρά κελιών;
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Αγαπητή Debbie,
Δοκιμάστε τον παρακάτω κώδικα VBA για να λύσετε το πρόβλημα.

Προσωπικό φύλλο εργασίας Sub_change (ByVal Target As Range)
Εάν Target.Cells.Count > 1 Στη συνέχεια, πραγματοποιήστε έξοδο από το Sub
Αν (Not Intersect(Target, Range("A1:D4")) Is Nothing) And (Target.Value > 200) Τότε
Καλέστε το Mail_small_Text_Outlook
End If
Sub End
Sub Mail_small_Text_Outlook()
Dim xOutApp ως αντικείμενο
Dim xOutMail ως αντικείμενο
Dim xMailBody ως συμβολοσειρά
Ορισμός xOutApp = CreateObject ("Outlook.Application")
Ορισμός xOutMail = xOutApp.CreateItem(0)
xMailBody = "Γεια σου" & vbNewLine & vbNewLine & _
"Αυτή είναι η γραμμή 1" & vbNewLine & _
"Αυτή είναι η γραμμή 2"
On Error Συνέχιση Επόμενη
Με xOutMail
.To = "Η διεύθυνση email του παραλήπτη σας"
.CC = ""
.BCC = ""
.Θέμα = "αποστολή με δοκιμή τιμής κελιού"
.Body = xMailBody
.Εμφάνιση ή χρήση .Αποστολή
Τέλος με
Στο σφάλμα GoTo 0
Ορισμός xOutMail = Τίποτα
Ρύθμιση xOutApp = Τίποτα
Sub End
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Αντιμετωπίζω πρόβλημα να ζητήσω από αυτόν τον κωδικό εάν η τιμή στο κελί αλλάξει έμμεσα. Για παράδειγμα, εάν έχω την εξίσωση Sum αλλάζει αυτόματα αυτή την τιμή. Όταν η εξίσωση εκτελείται και η τιμή υπερβαίνει την καθορισμένη τιμή για να ζητηθεί το μήνυμα ηλεκτρονικού ταχυδρομείου, δεν το κάνει, εκτός εάν αλλάξω φυσικά τον αριθμό ο ίδιος. Υπάρχει τρόπος να ζητηθεί το email ακόμα κι αν αλλάξει έμμεσα;
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Αγαπητέ Ιορδάνη,
Ο παρακάτω κώδικας VBA μπορεί να σας βοηθήσει να λύσετε το πρόβλημα. Μην ξεχάσετε να αντικαταστήσετε τη "Διεύθυνση Email" με τη διεύθυνση email του παραλήπτη στον κωδικό. Σας ευχαριστώ.

Προσωπικό φύλλο εργασίας Sub_change (ByVal Target As Range)
Dim xRgPre As Range
On Error Συνέχιση Επόμενη
Εάν Target.Cells.Count > 1 Στη συνέχεια, πραγματοποιήστε έξοδο από το Sub
Ορισμός xRg = Εύρος ("D7")
Ορίστε xRgPre = xRg.Προηγούμενα
Αν xRg.Τιμή > 200 Τότε
Αν Target.Address = xRg.Address Τότε
Καλέστε το Mail_small_Text_Outlook
ElseIf (Not xRgPre Is Nothing) And (Intersect(Target, xRgPre).Address = Target.Address) Τότε
Καλέστε το Mail_small_Text_Outlook
End If
End If
Sub End
Sub Mail_small_Text_Outlook()
Dim xOutApp ως αντικείμενο
Dim xOutMail ως αντικείμενο
Dim xMailBody ως συμβολοσειρά
Ορισμός xOutApp = CreateObject ("Outlook.Application")
Ορισμός xOutMail = xOutApp.CreateItem(0)
xMailBody = "Γεια σου" & vbNewLine & vbNewLine & _
"Αυτή είναι η γραμμή 1" & vbNewLine & _
"Αυτή είναι η γραμμή 2"
On Error Συνέχιση Επόμενη
Με xOutMail
.To = "Διεύθυνση ηλεκτρονικού ταχυδρομείου"
.CC = ""
.BCC = ""
.Θέμα = "αποστολή με δοκιμή τιμής κελιού"
.Body = xMailBody
.Εμφάνιση ή χρήση .Αποστολή
Τέλος με
Στο σφάλμα GoTo 0
Ορισμός xOutMail = Τίποτα
Ρύθμιση xOutApp = Τίποτα
Sub End
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Τροποποίησα τον προτεινόμενο κώδικα για να προσπαθήσω να τον κάνω να λειτουργεί για την εφαρμογή μου.
Άλλαξε xRg = Εύρος ("C2:C40") και Αν xRg.Τιμή = -1.

Το πρόβλημα που αντιμετωπίζω είναι οποιαδήποτε στιγμή υπάρχει αλλαγή σε οποιοδήποτε κελί και εφόσον ένα από τα κελιά στην περιοχή μου είναι = -1, θα καλεί Mail_small_Text_Outlook.
Προσπαθώ να καλέσω μόνο εάν κάποιο κελί στην περιοχή μου αλλάξει έμμεσα σε -1.
Αναρωτιόμουν επίσης αν και πώς θα ήταν δυνατόν να πληροί δύο κριτήρια.
Όπως ελέγξτε το εύρος Α και το εύρος Β και αν πληρούν κριτήρια καλέστε τη λειτουργία.

Ευχαριστώ εκ των προτέρων για τη βοήθεια. Είμαι νέος σε όλα αυτά, αλλά διαβάζοντας αυτό το νήμα με έχει περίπου το 90% εκεί.


Προσωπικό φύλλο εργασίας Sub_change (ByVal Target As Range)
Dim xRgPre As Range
On Error Συνέχιση Επόμενη
Εάν Target.Cells.Count > 1 Στη συνέχεια, πραγματοποιήστε έξοδο από το Sub
Ορισμός xRg = Εύρος ("C2:C40")
Ορίστε xRgPre = xRg.Προηγούμενα
Αν xRg.Τιμή = -1 Τότε
Αν Target.Address = xRg.Address Τότε
Καλέστε το Mail_small_Text_Outlook
ElseIf (Not xRgPre Is Nothing) And (Intersect(Target, xRgPre).Address = Target.Address) Τότε
Καλέστε το Mail_small_Text_Outlook
End If
End If
Sub End
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Χρησιμοποίησα αυτόν τον κωδικό με τη μόνη αλλαγή να τον έχω εφαρμόσει σε ολόκληρη στήλη [Set xRg = Range("D4:D13")]. Τώρα το συμβάν ενεργοποιείται κάθε φορά που γίνεται ένας υπολογισμός, ανεξάρτητα από το αν η βαλβίδα στη στήλη D είναι κάτω από την τιμή στόχο. Καμιά ιδέα γιατί είναι αυτό;


Dim Xrg As Range
Προσωπικό φύλλο εργασίας Sub_change (ByVal Target As Range)
Dim xRgPre As Range
On Error Συνέχιση Επόμενη
Εάν Target.Cells.Count > 1 Στη συνέχεια, πραγματοποιήστε έξοδο από το Sub
Ορισμός Xrg = Εύρος ("D4:D13")
Ορίστε xRgPre = Xrg.Προηγούμενα
Αν Xrg.Τιμή < 1200 Τότε
Εάν Target.Address = Xrg.Address Τότε
Καλέστε το Mail_small_Text_Outlook
ElseIf (Not xRgPre Is Nothing) And (Intersect(Target, xRgPre).Address = Target.Address) Τότε
Καλέστε το Mail_small_Text_Outlook
End If
End If
Sub End

Sub Mail_small_Text_Outlook()
Dim xOutApp ως αντικείμενο
Dim xOutMail ως αντικείμενο
Dim xMailBody ως συμβολοσειρά
Ορισμός xOutApp = CreateObject ("Outlook.Application")
Ορισμός xOutMail = xOutApp.CreateItem(0)
xMailBody = "Γεια" & vbNewLine & _
"Δοκιμή vba" _
& vbNewLine & _
"Γραμμή 2."
On Error Συνέχιση Επόμενη
Με xOutMail
.To = ""
.CC = ""
.BCC = ""
.Subject = "Auto Email Test"
.Body = xMailBody
.Απεικόνιση
Τέλος με
Στο σφάλμα GoTo 0
Ορισμός xOutMail = Τίποτα
Ρύθμιση xOutApp = Τίποτα

Sub End


Ευχαριστώ.
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Γεια σας

Αντιμετωπίζω πρόβλημα γιατί ο παραλήπτης email πρέπει να προστίθεται ξανά και ξανά ένας προς έναν. Παρακαλούμε καθοδηγήστε εάν η λίστα παραληπτών email μπορεί να προστεθεί σε αυτήν τη λειτουργία, ώστε η συνάρτηση να επιλέξει τη διεύθυνση email από τη λίστα των διευθύνσεων email που παρέχονται ή τη λίστα μεταφόρτωσης και η συνάρτηση να στείλει το email, που έχει ήδη συνταχθεί στον επιθυμητό παραλήπτη.
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Αγαπητέ Henry,
Ο παρακάτω κώδικας VBA μπορεί να σας βοηθήσει να λύσετε το πρόβλημα. Τοποθετήστε το σενάριο VBA στη μονάδα του φύλλου εργασίας σας. Όταν η τιμή στο καθορισμένο κελί πληροί την προϋπόθεση, θα εμφανιστεί ένα παράθυρο διαλόγου Kutools για Excel, επιλέξτε τα κελιά που περιέχουν τις διευθύνσεις email των παραληπτών και, στη συνέχεια, κάντε κλικ στο κουμπί OK. Στη συνέχεια ανοίγουν μηνύματα ηλεκτρονικού ταχυδρομείου με καθορισμένους παραλήπτες. Στείλτε τα όπως χρειάζεστε.

Προσωπικό φύλλο εργασίας Sub_change (ByVal Target As Range)
Εάν Target.Cells.Count > 1 Στη συνέχεια, πραγματοποιήστε έξοδο από το Sub
Ορισμός xRg = Εύρος ("D7")
Αν xRg = Target And Target.Value > 200 Τότε
Καλέστε το Mail_small_Text_Outlook
End If
Sub End
Sub Mail_small_Text_Outlook()
Dim xOutApp ως αντικείμενο
Dim xOutMail ως αντικείμενο
Dim xMailBody ως συμβολοσειρά
Dim xRgMsg ως εύρος
Dim xCell ως εύρος
Ορίστε xRgMsg = Application.InputBox("Επιλέξτε τα κελιά διεύθυνσης:", "Kutools for Excel", , , , , , 8)
xMailBody = "Γεια σου" & vbNewLine & vbNewLine & _
"Αυτή είναι η γραμμή 1" & vbNewLine & _
"Αυτή είναι η γραμμή 2"
On Error Συνέχιση Επόμενη
Για κάθε xCell Σε xRgMsg
Ορισμός xOutApp = CreateObject ("Outlook.Application")
Ορισμός xOutMail = xOutApp.CreateItem(0)
Με xOutMail
.To = xCell.Value
.CC = ""
.BCC = ""
.Θέμα = "αποστολή με δοκιμή τιμής κελιού"
.Body = xMailBody
.Εμφάνιση ή χρήση .Αποστολή
Τέλος με
xOutApp = Τίποτα
xOutMail = Τίποτα
επόμενος
Στο σφάλμα GoTo 0
Sub End
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
θα σταλεί αυτόματα mail, χωρίς καμία μη αυτόματη διακοπή
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Αγαπητέ Μπράχμα,
Εάν θέλετε να στείλετε απευθείας το email χωρίς εμφάνιση, αντικαταστήστε τη γραμμή ".Display" με ".Send" στον παραπάνω κωδικό VBA.
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Γεια σας έβαλα το ίδιο σενάριο αλλά δεν λειτουργεί παρακαλώ βοηθήστε με στο 1ο μέρος

Dim xRg ως εύρος

Προσωπικό φύλλο εργασίας Sub_change (ByVal Target As Range)
Εάν Target.Cells.Count > 1 Στη συνέχεια, πραγματοποιήστε έξοδο από το Sub
Ορισμός xRg = Εύρος ("D7")
Αν xRg = Target And Target.Value = 200 Τότε
Καλέστε το Mail_small_Text_Outlook
End If

Sub End
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Αγαπητέ βασιλιά,
Υπάρχει κάποια προειδοποίηση κατά την εκτέλεση του κωδικού;
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Γεια σας, πώς θα τροποποιούσατε αυτόν τον κωδικό για να ελέγξετε εάν μια ομάδα κελιών έχει τη συμβολοσειρά "No match" και να στείλετε ένα email εάν έχει.
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Αγαπητέ Jose,
Δοκιμάστε τον παρακάτω κώδικα VBA. Κατά την εκτέλεση του κώδικα, εμφανίζεται ένα παράθυρο διαλόγου, επιλέξτε το εύρος που θα ελέγξετε για συμβολοσειρά και κάντε κλικ στο κουμπί OK. Εάν η συμβολοσειρά δεν υπάρχει, θα λάβετε ένα παράθυρο διαλόγου. Εάν η συμβολοσειρά υπάρχει στην περιοχή, θα εμφανιστεί ένα email με καθορισμένο παραλήπτη, θέμα και σώμα.

Sub sendemail ()
Dim I As Long
Dim J As Long
Dim xRg ως εύρος
Dim xArr
Dim xOutApp ως αντικείμενο
Dim xOutMail ως αντικείμενο
Dim xMailBody ως συμβολοσειρά
Dim xFlag ως Boolean
On Error Συνέχιση Επόμενη
Set xRg = Application.InputBox("Please select range", "Kutools for Excel", Selection.Address, , , , , 8)
Εάν το xRg δεν είναι τίποτα, τότε βγείτε από το Sub
xArr = xRg.Τιμή
xFlag = Λάθος
Για I = 1 To UBound(xArr)
Για J = 1 σε UBound(xArr, 2)
Αν xArr(I, J) = "Χωρίς ταίριασμα" Τότε
xFlag = Αληθινό
End If
επόμενος
επόμενος
Αν xFlag Τότε
Ορισμός xOutApp = CreateObject ("Outlook.Application")
Ορισμός xOutMail = xOutApp.CreateItem(0)
xMailBody = "Γεια σου" & vbNewLine & vbNewLine & _
"Αυτή είναι η γραμμή 1" & vbNewLine & _
"Αυτή είναι η γραμμή 2"
Με xOutMail
.To = "Διεύθυνση email"
.CC = ""
.BCC = ""
.Θέμα = "Ταίριασμα"
.Body = xMailBody
.Εμφάνιση ή χρήση .Αποστολή
Τέλος με
Αλλού
MsgBox "Δεν βρέθηκε αντιστοιχισμένη τιμή", vbInformation, "KuTools for Excel"
End If
Sub End
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Πώς θα μπορούσα να αλλάξω αυτόν τον κωδικό για την αποστολή των βαθμών των μαθητών στους γονείς. Όπου εάν η στήλη Α είναι ο βαθμός και η Στήλη Β είναι το γονικό email. Θέλω να συμπληρώσω ένα email για κάθε μαθητή με βαθμό F.
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Αγαπητέ Φρανκ,
Ο παρακάτω κώδικας VBA μπορεί να σας βοηθήσει να λύσετε το πρόβλημα. Σας ευχαριστώ.

Sub Mail_small_Text_Outlook()
Dim xRg ως εύρος
Dim I As Long
Dim xRows As Long
Dim xVal ως συμβολοσειρά
Dim xOutApp ως αντικείμενο
Dim xOutMail ως αντικείμενο
Dim xMailBody ως συμβολοσειρά
On Error Συνέχιση Επόμενη
Ορίστε xRg = Application.InputBox("Παρακαλώ επιλέξτε τη στήλη βαθμού και τη στήλη email (δύο στήλες)", "Kutools for Excel", Selection.Address, , , , , 8)
Εάν το xRg δεν είναι τίποτα, τότε βγείτε από το Sub
xRows = xRg.Rows.Count
Ορισμός xRg = xRg(2)
Για I = 1 έως xRows
xVal = xRg.Offset(I, -1).Κείμενο
Αν xVal = "F" Τότε
Ορισμός xOutApp = CreateObject ("Outlook.Application")
Ορισμός xOutMail = xOutApp.CreateItem(0)
xMailBody = "Γεια σου" & vbNewLine & vbNewLine & _
"Αυτός είναι ο βαθμός του παιδιού σας" & xRg.Offset(I, -1).Κείμενο
Με xOutMail
.to = xRg.Offset(I, 0).Κείμενο
.Θέμα = "αποστολή με δοκιμή τιμής κελιού"
.Body = xMailBody
.Εμφάνιση ή χρήση .Αποστολή
Τέλος με
Στο σφάλμα GoTo 0
Ορισμός xOutMail = Τίποτα
Ρύθμιση xOutApp = Τίποτα
End If
επόμενος
Sub End
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Έχω μια λίστα με διευθύνσεις email ήδη σε ένα αρχείο excel, πώς μπορώ να τροποποιήσω τον κωδικό ώστε να επιλέγει αυτόματα τη διεύθυνση email του ατόμου εάν το κελί του D7 είναι >200;
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Καλή μέρα,
Ο παρακάτω κώδικας VBA μπορεί να σας βοηθήσει να λύσετε το πρόβλημα. Τοποθετήστε το σενάριο VBA στη μονάδα του φύλλου εργασίας σας. Όταν η τιμή στο καθορισμένο κελί πληροί την προϋπόθεση, θα εμφανιστεί ένα παράθυρο διαλόγου Kutools για Excel, επιλέξτε τα κελιά που περιέχουν τις διευθύνσεις email των παραληπτών και, στη συνέχεια, κάντε κλικ στο κουμπί OK. Στη συνέχεια ανοίγουν μηνύματα ηλεκτρονικού ταχυδρομείου με καθορισμένους παραλήπτες. Στείλτε τα όπως χρειάζεστε.

Προσωπικό φύλλο εργασίας Sub_change (ByVal Target As Range)
Εάν Target.Cells.Count > 1 Στη συνέχεια, πραγματοποιήστε έξοδο από το Sub
Ορισμός xRg = Εύρος ("D7")
Αν xRg = Target And Target.Value > 200 Τότε
Καλέστε το Mail_small_Text_Outlook
End If
Sub End
Sub Mail_small_Text_Outlook()
Dim xOutApp ως αντικείμενο
Dim xOutMail ως αντικείμενο
Dim xMailBody ως συμβολοσειρά
Dim xRgMsg ως εύρος
Dim xCell ως εύρος
Ορίστε xRgMsg = Application.InputBox("Επιλέξτε τα κελιά διεύθυνσης:", "Kutools for Excel", , , , , , 8)
xMailBody = "Γεια σου" & vbNewLine & vbNewLine & _
"Αυτή είναι η γραμμή 1" & vbNewLine & _
"Αυτή είναι η γραμμή 2"
On Error Συνέχιση Επόμενη
Για κάθε xCell Σε xRgMsg
Ορισμός xOutApp = CreateObject ("Outlook.Application")
Ορισμός xOutMail = xOutApp.CreateItem(0)
Με xOutMail
.To = xCell.Value
.CC = ""
.BCC = ""
.Θέμα = "αποστολή με δοκιμή τιμής κελιού"
.Body = xMailBody
.Εμφάνιση ή χρήση .Αποστολή
Τέλος με
xOutApp = Τίποτα
xOutMail = Τίποτα
επόμενος
Στο σφάλμα GoTo 0
Sub End
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Αντιμετωπίζω πρόβλημα με την αποστολή αλληλογραφίας μέσω του Outlook. Λαμβάνω το σφάλμα που λέει "Ένα πρόγραμμα προσπαθεί να στείλει ένα μήνυμα ηλεκτρονικού ταχυδρομείου εκ μέρους σας. Εάν είναι απροσδόκητο, αρνηθείτε και βεβαιωθείτε ότι το λογισμικό προστασίας από ιούς είναι ενημερωμένο"
Παρακαλώ βοηθήστε γιατί δεν μπορώ να το αυτοματοποιήσω.
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Συγγνώμη mayank,
Ο κώδικας λειτουργεί καλά στην περίπτωσή μου. Φαίνεται ότι κάτι σχετικά με τη λειτουργία "αποστολή για λογαριασμό" έχει ρυθμιστεί στο Outlook σας. Ελέγχετε για αυτό.
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Γεια σας, τι κωδικό θα χρησιμοποιούσα εάν προσπαθώ να στείλω ένα email σε έναν διευθυντή που έχει μια λίστα με τα φρούτα που έχει ποσότητα > 200 μία φορά το μήνα (βάσει του παραδείγματός σας) ή λήγει σύντομα (βάσει ημερομηνιών)
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Good Day
Μπορεί να είναι η μέθοδος σε αυτό το άρθρο "Πώς να στείλετε email εάν έχει συμπληρωθεί η ημερομηνία λήξης στο Excel;" μπορώ να σε βοηθήσω.
Παρακαλώ ακολουθήστε αυτόν τον σύνδεσμο: https://www.extendoffice.com/documents/excel/4664-excel-send-email-if-due-date-has-been-met.html
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Πώς μπορώ να επεξεργαστώ τον κωδικό για να στείλω ένα email με βάση μια ημερομηνία στο κελί. Για παράδειγμα, χρειάζομαι ένα έγγραφο που εξετάζεται κάθε 15 μήνες και θέλω να στείλω ένα μήνυμα ηλεκτρονικού ταχυδρομείου στους 12 μήνες σε μια διεύθυνση ηλεκτρονικού ταχυδρομείου που λέει ότι το έγγραφο πρέπει να ελεγχθεί. Το έχω τώρα για αυτόματη αποστολή ενός email αλλάζοντας το .Display σε .Send και λειτουργεί τέλεια όπως γράφτηκε, αλλά τι πρέπει να αλλάξω για να χρησιμοποιήσω μια συνάρτηση ημερομηνίας αντί για έναν ακέραιο αριθμό;
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Πώς μπορείτε να προσθέσετε Πολλαπλό εύρος στο "Set xRg = Range("D7")". Θέλω να το επεξεργαστώ και να προσθέσω Εύρος ("D7:F7"). Ωστόσο, λαμβάνω ένα σφάλμα Run Time Error 13, Type Mismatch και με οδηγεί στο If xRg = Target And Target.Value > 2 Τότε.


Πώς μπορώ να λύσω αυτό το πρόβλημα;
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Καλή μέρα,
Δοκιμάστε τον παρακάτω κώδικα VBA για να λύσετε το πρόβλημα.

Προσωπικό φύλλο εργασίας Sub_change (ByVal Target As Range)
Εάν Target.Cells.Count > 1 Στη συνέχεια, πραγματοποιήστε έξοδο από το Sub
Αν (Not Intersect(Target, Range("D7:F7")) Is Nothing) And (Target.Value > 200) Τότε
Καλέστε το Mail_small_Text_Outlook
End If
Sub End
Sub Mail_small_Text_Outlook()
Dim xOutApp ως αντικείμενο
Dim xOutMail ως αντικείμενο
Dim xMailBody ως συμβολοσειρά
Ορισμός xOutApp = CreateObject ("Outlook.Application")
Ορισμός xOutMail = xOutApp.CreateItem(0)
xMailBody = "Γεια σου" & vbNewLine & vbNewLine & _
"Αυτή είναι η γραμμή 1" & vbNewLine & _
"Αυτή είναι η γραμμή 2"
On Error Συνέχιση Επόμενη
Με xOutMail
.To = "Η διεύθυνση email του παραλήπτη σας"
.CC = ""
.BCC = ""
.Θέμα = "αποστολή με δοκιμή τιμής κελιού"
.Body = xMailBody
.Εμφάνιση ή χρήση .Αποστολή
Τέλος με
Στο σφάλμα GoTo 0
Ορισμός xOutMail = Τίποτα
Ρύθμιση xOutApp = Τίποτα
Sub End
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
δούλεψε μια χαρά.. Ευχαριστώ..:):)
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Δεν λειτουργεί για μένα, καθώς η τιμή στο D7 είναι αποτέλεσμα μιας τυπικής. Τι γίνεται αν το κελί D7 περιέχει έναν τύπο, π.χ. D7 =2*120; Εξακολουθεί να πληροί την προϋπόθεση αλλά δεν συμβαίνει τίποτα. Παρακαλώ βοηθήστε
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
πώς να σταματήσετε την εκτέλεση του κώδικα, δηλαδή να μην σας ζητηθεί το email όταν δεν πληρούται η προϋπόθεση;

ακόμα και όταν D7 < 200, εξακολουθεί να μου ζητείται το email.
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Καλή μέρα,
Ο κώδικας ενημερώνεται στην ανάρτηση με το πρόβλημα λυμένο. Σας ευχαριστούμε για το σχόλιό σας.
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Hi

Σας ευχαριστούμε πολύ για τη δημοσίευση αυτού του κώδικα VBA και των οδηγιών. Όταν το βρήκα ένιωσα σαν να είχα κερδίσει το λότο. Ωστόσο, έχω κολλήσει σε κάτι, οπότε ελπίζω ότι μπορείτε να βοηθήσετε (είμαι νέος στο VBA, έχω μόνο πολύ βασική κατανόηση).

Αντέγραψα τον κώδικα και άλλαξα την τιμή του κελιού και του κελιού για να επιλέξω από μια περιοχή, εάν πληρούνται κάποιο κριτήριο. Έχω δοκιμάσει και δοκιμάσει και λειτουργεί και έλαβα ένα email στο outlook με βάση τα κριτήρια.

1) Ωστόσο, δεν μπορώ να καταλάβω πώς να εκτελείται αυτόματα ο κώδικας VBA όταν ανοίγω το φύλλο εργασίας του excel, αντί να χρειάζεται να κάνω κλικ στην εφαρμογή VBA και να επιλέξω την εκτέλεση. Θα μπορούσατε να συμβουλεύσετε εάν υπάρχει μια πρόσθετη προτροπή για να πληκτρολογήσετε τον παραπάνω κώδικα VBA που θα το κάνει αυτό ή πρέπει να γίνει ξεχωριστά.

2) Υπάρχει επίσης τρόπος να λάβετε τον κωδικό VBA για να στείλετε ένα μήνυμα ηλεκτρονικού ταχυδρομείου σε ένα άτομο εάν η ημερομηνία λήξης είναι ναι για ένα συγκεκριμένο αντικείμενο, όπως φαίνεται στο παράδειγμα παρακάτω.
κρυφή στήλη email
Όνοματεπώνυμο

Διαδικασία
Διαδικασία αρ. 1 ημερομηνία λήξης ναι
Διαδικασία αρ. 2 ημερομηνία λήξης αρ

Θα είχα πολλά άτομα στο υπολογιστικό φύλλο (που περνούν οριζόντια στη σειρά) και το "Ναι" θα μπορούσε να επισημανθεί για διάφορες εκπρόθεσμες διαδικασίες (αναφέρονται κάθετα στη στήλη Α. Υπάρχει τρόπος να δημιουργήσετε έναν κωδικό VBA που να εκτελείται για κάτι τέτοιο - εάν «Ναι» για το «Άτομο 1», τότε στείλτε μήνυμα ηλεκτρονικού ταχυδρομείου στο «άτομο 1» με «αριθμός διαδικασίας #» (ή αριθμούς) και ημερομηνία(ες) λήξης. Μπορείτε να αναφέρετε στο email όλες τις διαδικασίες και τις επόμενες ημερομηνίες λήξης τους.

Δεν θα με πείραζε αν έπρεπε να ορίσω έναν ξεχωριστό κωδικό VBA για κάθε άτομο, αρκεί να έστελνε ένα mail με όλα τα καθυστερημένα έγγραφα για αυτό το άτομο και τις ημερομηνίες λήξης.

Ελπίζοντας ότι μπορείτε να βοηθήσετε
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Αγαπητή Αννα,
Δοκιμάστε τον παρακάτω κώδικα VBA. Σας ευχαριστούμε για το σχόλιό σας.

Sub Mail_small_Text_Outlook()
Dim xRg ως εύρος
Dim xCell ως εύρος
Dim I As Long
Dim xRows As Long
Dim XCOLs όσο πολύ καιρό
Dim xVal ως συμβολοσειρά
Dim xOutApp ως αντικείμενο
Dim xOutMail ως αντικείμενο
Dim xMailBody ως συμβολοσειρά
On Error Συνέχιση Επόμενη
Ορισμός xRg = Application.InputBox("Επιλέξτε το εύρος που περιέχει την τιμή του κελιού που θα στείλετε email με βάση:", "Kutools for Excel", Selection.Address, , , , , 8)
Εάν το xRg δεν είναι τίποτα, τότε βγείτε από το Sub
xRows = xRg.Rows.Count
xCols = xRg.Columns.Count
Για I = 1 έως xRows
Ορισμός xCell = xRg(I, xCols)
Αν xCell.Value = "Ναι" Τότε
Ορισμός xOutApp = CreateObject ("Outlook.Application")
Ορισμός xOutMail = xOutApp.CreateItem(0)
xMailBody = "Γεια σου" & vbNewLine & vbNewLine & _
"Αυτές είναι οι πληροφορίες σας: " & vbNewLine & xCell.Offset(0, -1).Text & vbNewLine & xCell.Offset(0, -2).Text
Με xOutMail
.To = xCell.Offset(0, -4).Κείμενο
.Θέμα = "αποστολή με δοκιμή τιμής κελιού"
.Body = xMailBody
.Εμφάνιση ή χρήση .Αποστολή
Τέλος με
Στο σφάλμα GoTo 0
Ορισμός xOutMail = Τίποτα
Ρύθμιση xOutApp = Τίποτα
End If
επόμενος
Sub End
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Κρύσταλλο,

Αυτό αντικαθιστά τον ακόλουθο κώδικα:

Δευτερεύον email()

Dim xRg ως εύρος

Dim xRgEach ως εύρος

Dim xEmail_Subject, xEmail_Send_Form, κ.λπ.
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Πού ακριβώς εισάγουμε αυτόν τον κωδικό;
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Καλή σας μέρα,
Πρέπει να τοποθετήσετε τον κώδικα στο παράθυρο κώδικα του φύλλου εργασίας.
Ανοίξτε το παράθυρο Microsoft Visual Basic for Applications, κάντε διπλό κλικ στο όνομα του φύλλου στο αριστερό παράθυρο για να ανοίξετε το πρόγραμμα επεξεργασίας κώδικα.
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Γεια σου,


Αυτήν τη στιγμή αντιμετωπίζω λίγο πρόβλημα με την κωδικοποίηση (νέο σε αυτό - μπορεί να έχει δαγκώσει περισσότερα από όσα μπορώ να μασήσω)


Αυτήν τη στιγμή έχω ένα υπολογιστικό φύλλο με τα ακόλουθα που χρειάζομαι βοήθεια για την αυτοματοποίηση και την αποστολή email για σφάλματα που βρίσκονται στα ακίνητά μας για την επιχείρησή μας


Αυτήν τη στιγμή χρειάζομαι έναν κωδικό που θα χρησιμοποιεί τα ακόλουθα δεδομένα:


1) Μια διεύθυνση και το ζήτημα ( 2 "γενικά" κελιά που έχουν συγχωνευθεί μέσω ((Στο κελί D1)) " = =CONCAT(B1," "C1,) "
Η διεύθυνση στο B1 θα είναι πάντα ίδια (περισσότερο ή λιγότερο)
Ενώ το C1 θα αλλάζει πάντα ανάλογα με το σφάλμα στο ακίνητο.


2) Ένα μήνυμα ηλεκτρονικού ταχυδρομείου που θα σταλεί με την ίδια διεύθυνση email, (μπορώ να χρησιμοποιήσω $E$1 ή πρέπει να χρησιμοποιήσω E1 - E1 . για παράδειγμα) ή μπορώ απλώς να εισάγω " TheEmailAdress@.co.uk" στη γραμμή κώδικα


3) Το σώμα του email που θα συμπληρωθεί με τον ίδιο τρόπο με το σημείο 1) ...... ((Στο κελί F1)) " =CONCAT(G1," ",H1)
Αυτά θα αλλάζουν συνεχώς καθώς αντιπροσωπεύουν την εταιρεία (G1) και τι κάνουν, διορθώνουν, αναφέρουν κ.λπ. (H1)

4) Το έναυσμα για να σταλεί το email, θα ήμουν ο αριθμός 7, το φύλλο ενημερώνεται καθημερινά (7 ημέρες την εβδομάδα)
Ως εκ τούτου, χρειάζομαι το έναυσμα για να στείλω το email την ημέρα 7, αλλά όχι συνεχώς όπως την ημέρα 8, 9, 10+ κ.λπ. και όχι πριν όπως το 1-6, αυτό θα ήταν σε Α4 : Α 100+ (καθώς επεκτείνουμε συνεχώς


4) Χρησιμοποίησα μικρά αποσπάσματα από άλλους χρήστες που ανέφεραν ότι χρησιμοποιούσα μια λίστα για το έναυσμα για την αποστολή του μηνύματος ηλεκτρονικού ταχυδρομείου, αλλά δεν είμαι σίγουρος ότι ήταν 100% σωστό, αλλά θα το χρειαζόμουν για σάρωση όλων των Στήλων Α... A4: A100
και αν υπάρχουν 47 κελιά που περιέχουν μόνο " 7 " τότε θα σταλούν 47 email


Σας ευχαριστώ πολύ για την ανάγνωση και ελπίζω να μπορέσετε να βοηθήσετε :)
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Αγαπητέ Μάρτιν,
Συγγνώμη δεν μπορώ να βοηθήσω με αυτό.
Μπορείτε να δημοσιεύσετε την ερώτησή σας στο φόρουμ μας: https://www.extendoffice.com/forum.html για να λάβετε περισσότερη υποστήριξη Excel από το τεχνικό μας προσωπικό.
Σας ευχαριστώ για το σχόλιό σας.

Best Regards,
Κρύσταλλο
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Γεια σας,


Τι θα συμβεί αν ήθελα να στείλω το email με βάση τη λέξη "ολοκληρώθηκε" που προστέθηκε στη στήλη L;
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Αγαπητέ Jesse,
Ο παρακάτω κώδικας VBA μπορεί να σας βοηθήσει να λύσετε το πρόβλημα. Σας ευχαριστούμε για το σχόλιό σας.

Προσωπικό φύλλο εργασίας Sub_change (ByVal Target As Range)
Εάν Target.Cells.Count > 1 Στη συνέχεια, πραγματοποιήστε έξοδο από το Sub
If (Not Intersect(Target, Range("L:L")) Is Nothing) And (Target.Value = "ολοκληρώθηκε") Τότε
Καλέστε το Mail_small_Text_Outlook
End If
Sub End
Sub Mail_small_Text_Outlook()
Dim xOutApp ως αντικείμενο
Dim xOutMail ως αντικείμενο
Dim xMailBody ως συμβολοσειρά
Ορισμός xOutApp = CreateObject ("Outlook.Application")
Ορισμός xOutMail = xOutApp.CreateItem(0)
xMailBody = "Γεια σου" & vbNewLine & vbNewLine & _
"Αυτή είναι η γραμμή 1" & vbNewLine & _
"Αυτή είναι η γραμμή 2"
On Error Συνέχιση Επόμενη
Με xOutMail
.To = "Η διεύθυνση email του παραλήπτη σας"
.CC = ""
.BCC = ""
.Θέμα = "αποστολή με δοκιμή τιμής κελιού"
.Body = xMailBody
.Εμφάνιση ή χρήση .Αποστολή
Τέλος με
Στο σφάλμα GoTo 0
Ορισμός xOutMail = Τίποτα
Ρύθμιση xOutApp = Τίποτα
Sub End
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Γεια σας,
Θα ήθελα το Outlook να εμφανίζεται μόνο όταν τα δεδομένα που έχω επικολλήσει στο εύρος ("D7:F7") έχουν τουλάχιστον 1 μηδέν ή ένα κενό.
Έχω αφαιρέσει τη γραμμή "If Target.Cells.Count > 1 After Exit Sub" και τώρα το Outlook εκκινείται πάντα όταν επικολλώ οποιαδήποτε ομάδα τιμών στα κελιά D7:F7.

Βοήθεια.
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Αγαπητέ Γιάννη,
Το παρακάτω σενάριο μπορεί να σας βοηθήσει να λύσετε το πρόβλημα. Σας ευχαριστούμε για το σχόλιό σας.

Προσωπικό φύλλο εργασίας Sub_change (ByVal Target As Range)
Dim xOutApp ως αντικείμενο
Dim xOutMail ως αντικείμενο
Dim xMailBody ως συμβολοσειρά
On Error Συνέχιση Επόμενη
Αν Target.Address = Range("D7:F7").Address then
Με Application.WorksheetFunction
Αν .CountIf(Target, "") > 0 Ή .CountIf(Target, 0) > 0 Τότε
Ορισμός xOutApp = CreateObject ("Outlook.Application")
Ορισμός xOutMail = xOutApp.CreateItem(0)
Με xOutMail
.To = "Διεύθυνση ηλεκτρονικού ταχυδρομείου"
.CC = ""
.BCC = ""
.Θέμα = "αποστολή με δοκιμή τιμής κελιού"
.Body = "Γεια σου"
.Εμφάνιση ή χρήση .Αποστολή
Τέλος με
Στο σφάλμα GoTo 0
Ορισμός xOutMail = Τίποτα
Ρύθμιση xOutApp = Τίποτα
End If
Τέλος με
End If
Sub End
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Χρησιμοποίησα λοιπόν την επεξεργασία σας για να συμπεριλάβω ένα εύρος κελιών, αλλά (αν χρησιμοποιούμε το παράδειγμα φύλλου εργασίας) αναρωτιόμουν πώς να προσθέσω τον τύπο του φρούτου, την ημερομηνία και την ποσότητα στο μήνυμα ηλεκτρονικού ταχυδρομείου HTML από το φύλλο εργασίας, εάν πληρούν τα κριτήρια έχει δημιουργηθεί ένα email. Έτσι θα έλεγε

"Γεια σου,"

Όνομα φρούτου από το κελί "Πρέπει να τεθεί σε επαναπαραγγελία γιατί από την ημερομηνία παραγγελίας: " ημερομηνία παραγγελίας από το κελί "έχουμε αυτήν την ποσότητα:" ποσότητα από το κελί.
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Γεια σου Noemi,
Δοκιμάστε αυτό το σενάριο VBA.

Προσωπικό φύλλο εργασίας Sub_change (ByVal Target As Range)
Dim xRg ως εύρος
Dim I, J, K As Long
Dim xOutApp ως αντικείμενο
Dim xOutMail ως αντικείμενο
Dim xMailBody ως συμβολοσειρά
On Error Συνέχιση Επόμενη
Αν Target.Address = Range("D7").Address then
Με Application.WorksheetFunction
Αν IsNumeric(Target.Value) and Target.Value > 200 Τότε
Ορισμός xRg = Application.InputBox("Επιλέξτε την περιοχή κελιών που θα εμφανίσετε στο σώμα της αλληλογραφίας:", "KuTools για Excel", Selection.Address, , , , , 8)
Εάν το xRg δεν είναι τίποτα, τότε βγείτε από το Sub
Για I = 1 To xRg.Rows.Count
Για J = 1 To xRg.Rows(I).Columns.Count
Για K = 1 Προς xRg.Σειρές(I).Στήλες(J).Αριθμός
xMailBody = xMailBody & " " & xRg.Rows(I).Columns(J).Cells(K).Text
επόμενος
επόμενος
xMailBody = xMailBody & vbNewLine
επόμενος
Ορισμός xOutApp = CreateObject ("Outlook.Application")
Ορισμός xOutMail = xOutApp.CreateItem(0)
Με xOutMail
.To = "Διεύθυνση ηλεκτρονικού ταχυδρομείου"
.CC = ""
.BCC = ""
.Θέμα = "αποστολή με δοκιμή τιμής κελιού"
.Body = "Γεια σου" & vbNewLine & xMailBody
.Εμφάνιση ή χρήση .Αποστολή
Τέλος με
Στο σφάλμα GoTo 0
Ορισμός xOutMail = Τίποτα
Ρύθμιση xOutApp = Τίποτα
End If
Τέλος με
End If
Sub End
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
γεια σου κρύσταλλο
Ευχαριστώ για τους κωδικούς σας, εάν είναι δυνατόν, στείλτε τους κωδικούς για τις παρακάτω λεπτομέρειες

εάν έχουμε 8 έως 9 στήλες που χρησιμοποιούν διαφορετικούς τύπους λήξεων, όπως ημερομηνία λήξης διαβατηρίου, ημερομηνία λήξης άδειας οδήγησης, ημερομηνία λήξης ταξινόμησης οχήματος, ημερομηνία λήξης κάρτας πύλης και άλλα κ.λπ., και η ειδοποίηση αλληλογραφίας πρέπει να σταλεί μόνο σε 5 συγκεκριμένα άτομα.

όπως το φύλλο ημερομηνιών μας με περισσότερους από 300 υπαλλήλους, λήγει και ημερομηνία λήξης σε 15 ημέρες σε κόκκινο χρώμα και θα πρέπει να σταλεί ειδοποίηση μέσω email.

ευγενικά κάντε τα απαραίτητα

ευχαριστώ εκ των προτέρων
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Χαίρετε Κ.
Έχουμε δημοσιεύσει ένα άρθρο "Πώς να στείλετε email εάν έχει τηρηθεί η ημερομηνία λήξης στο Excel;"
Μπορείτε να δείτε αν υπάρχουν απαντήσεις σε αυτό το άρθρο. Ακολουθήστε αυτόν τον σύνδεσμο για να ανοίξετε το άρθρο: https://www.extendoffice.com/documents/excel/4664-excel-send-email-if-due-date-has-been-met.html
Σας ευχαριστώ.
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Γεια σας- Εάν ήθελα να στείλω σε ένα email από μια λίστα αντί να βάλω το πραγματικό πρόσθετο email στον κώδικα, είναι δυνατόν; ευχαριστώ
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Χαίρετε Κ.
Δοκιμάστε κάτω από τον κωδικό VBA, όταν το καθορισμένο κελί πληροί την προϋπόθεση, θα εμφανιστεί ένα παράθυρο διαλόγου, επιλέξτε το κελί που περιέχει τη διεύθυνση email στην οποία θα στείλετε email. Ελπίζω ότι μπορεί να βοηθήσει. Σας ευχαριστώ.

Προσωπικό φύλλο εργασίας Sub_change (ByVal Target As Range)
Εάν Target.Cells.Count > 1 Στη συνέχεια, πραγματοποιήστε έξοδο από το Sub
Ορισμός xRg = Εύρος ("D7")
Αν xRg = Target And Target.Value > 200 Τότε
Καλέστε το Mail_small_Text_Outlook
End If
Sub End
Sub Mail_small_Text_Outlook()
Dim xOutApp ως αντικείμενο
Dim xOutMail ως αντικείμενο
Dim xMailBody ως συμβολοσειρά
Dim xRgMsg ως εύρος
Dim xCell ως εύρος
Ορίστε xRgMsg = Application.InputBox("Επιλέξτε τα κελιά διεύθυνσης:", "Kutools for Excel", , , , , , 8)
xMailBody = "Γεια σου" & vbNewLine & vbNewLine & _
"Αυτή είναι η γραμμή 1" & vbNewLine & _
"Αυτή είναι η γραμμή 2"
On Error Συνέχιση Επόμενη
Για κάθε xCell Σε xRgMsg
Ορισμός xOutApp = CreateObject ("Outlook.Application")
Ορισμός xOutMail = xOutApp.CreateItem(0)
Με xOutMail
.To = xCell.Value
.CC = ""
.BCC = ""
.Θέμα = "αποστολή με δοκιμή τιμής κελιού"
.Body = xMailBody
.Εμφάνιση ή χρήση .Αποστολή
Τέλος με
xOutApp = Τίποτα
xOutMail = Τίποτα
επόμενος
Στο σφάλμα GoTo 0
Sub End
Δεν υπάρχουν σχόλια δημοσιεύτηκε ακόμα
Τοποθετήστε Περισσότερα
Αφήστε τα σχόλιά σας
Δημοσίευση ως επισκέπτης
×
Αξιολογήστε αυτήν την ανάρτηση:
0   Χαρακτήρες
Προτεινόμενες τοποθεσίες