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

Πώς να εισαγάγετε την υπογραφή του Outlook κατά την αποστολή email στο Excel;

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

Εισαγάγετε υπογραφή στο email του Outlook κατά την αποστολή μέσω του Excel VBA
Εισαγάγετε εύκολα την υπογραφή του Outlook κατά την αποστολή email στο Excel με ένα καταπληκτικό εργαλείο

Περισσότερα σεμινάρια για αποστολή στο Excel ...


Εισαγάγετε υπογραφή στο email του Outlook κατά την αποστολή μέσω του Excel VBA

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

1. Ανοίξτε το φύλλο εργασίας περιέχει τη λίστα διευθύνσεων email στην οποία θέλετε να στείλετε email και, στη συνέχεια, πατήστε το άλλος + F11 κλειδιά.

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

3. Τώρα πρέπει να αντικαταστήσετε το .Σώμα γραμμή σε VBA 2 με τον κωδικό στο VBA 1. Μετά από αυτό, μετακινήστε τη γραμμή .Απεικόνιση κάτω από τη γραμμή Με το xMailOut.

VBA 1: Πρότυπο αποστολής email με προεπιλεγμένη υπογραφή του Outlook στο Excel

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

VBA 2: Αποστολή email σε διευθύνσεις email που καθορίζονται σε κελιά στο Excel

Sub SendEmailToAddressInCells()
    Dim xRg As Range
    Dim xRgEach As Range
    Dim xRgVal As String
    Dim xAddress As String
    Dim xOutApp As Outlook.Application
    Dim xMailOut As Outlook.MailItem
    On Error Resume Next
    xAddress = ActiveWindow.RangeSelection.Address
    Set xRg = Application.InputBox("Please select email address range", "KuTools For Excel", xAddress, , , , , 8)
    If xRg Is Nothing Then Exit Sub
    Application.ScreenUpdating = False
    Set xOutApp = CreateObject("Outlook.Application")
    Set xRg = xRg.SpecialCells(xlCellTypeConstants, xlTextValues)
    For Each xRgEach In xRg
        xRgVal = xRgEach.Value
        If xRgVal Like "?*@?*.?*" Then
            Set xMailOut = xOutApp.CreateItem(olMailItem)
            With xMailOut
                .To = xRgVal
                .Subject = "Test"
                .Body = "Dear " _
                      & vbNewLine & vbNewLine & _
                        "This is a test email " & _
                        "sending in Excel"
                .Display
                '.Send
            End With
        End If
    Next
    Set xMailOut = Nothing
    Set xOutApp = Nothing
    Application.ScreenUpdating = True
End Sub

Το παρακάτω στιγμιότυπο οθόνης μπορεί να σας βοηθήσει να βρείτε εύκολα τις διαφορές μετά την αλλαγή του κώδικα VBA.

4. Πάτα το F5 κλειδί για την εκτέλεση του κώδικα. Μετά ένα Kutools για Excel εμφανίζεται το πλαίσιο επιλογής, επιλέξτε τις διευθύνσεις email στις οποίες θα στείλετε email και, στη συνέχεια, κάντε κλικ στο Εντάξει.

Στη συνέχεια δημιουργούνται email. Μπορείτε να δείτε την προεπιλεγμένη υπογραφή του Outlook να προστίθεται στο τέλος του σώματος του email.

Συμβουλές:

  • 1. Μπορείτε να αλλάξετε το σώμα email στον κωδικό VBA 1 ανάλογα με τις ανάγκες σας.
  • 2. Μετά την εκτέλεση του κώδικα, εάν εμφανιστεί ένα παράθυρο διαλόγου σφάλματος που προειδοποιεί ότι ο καθορισμένος από τον χρήστη τύπος δεν έχει οριστεί, κλείστε αυτόν τον διάλογο και, στη συνέχεια, μεταβείτε στο κλικ Εργαλεία > αναφορές στο Microsoft Visual Basic για εφαρμογές παράθυρο. Στο άνοιγμα Αναφορές - VBAProject παράθυρο, ελέγξτε το Βιβλιοθήκη αντικειμένων του Microsoft Outlook και κάντε κλικ στο κουμπί Εντάξει. Και μετά εκτελέστε ξανά τον κωδικό.

Εισαγάγετε εύκολα την υπογραφή του Outlook κατά την αποστολή email στο Excel με ένα καταπληκτικό εργαλείο

Εάν είστε αρχάριος στο VBA, προτείνουμε εδώ το Αποστολή email χρησιμότητα του Kutools για Excel για σενα. Με αυτήν τη δυνατότητα, μπορείτε εύκολα να στέλνετε μηνύματα ηλεκτρονικού ταχυδρομείου με βάση συγκεκριμένα πεδία στο Excel και να προσθέτετε υπογραφή του Outlook σε αυτά. Κάντε τα εξής:

Πριν από την εφαρμογή Kutools για Excel, σας παρακαλούμε κατεβάστε και εγκαταστήστε το πρώτα.

Πρώτον, πρέπει να δημιουργήσετε μια λίστα αλληλογραφίας με διαφορετικά πεδία στα οποία θα στέλνετε μηνύματα ηλεκτρονικού ταχυδρομείου.

Μπορείτε να δημιουργήσετε μη αυτόματα μια λίστα αλληλογραφίας όπως χρειάζεστε ή να εφαρμόσετε τη δυνατότητα Δημιουργία λίστας αλληλογραφίας για να την ολοκληρώσετε γρήγορα.

1. κλικ Kutools Plus > Δημιουργία λίστας αλληλογραφίας.

2. Στο Δημιουργία λίστας αλληλογραφίας πλαίσιο διαλόγου, καθορίστε τα πεδία που χρειάζεστε, επιλέξτε πού θα εξάγετε τη λίστα και, στη συνέχεια, κάντε κλικ στο OK κουμπί.

3. Τώρα δημιουργείται ένα δείγμα λίστας αλληλογραφίας. Δεδομένου ότι είναι μια λίστα δειγμάτων, πρέπει να αλλάξετε τα πεδία σε συγκεκριμένο απαραίτητο περιεχόμενο. (επιτρέπονται πολλές σειρές)

4. Μετά από αυτό, επιλέξτε ολόκληρη τη λίστα (συμπεριλάβετε κεφαλίδες), κάντε κλικ στο Kutools Plus > Αποστολή email.

5. Στο Αποστολή email κουτί διαλόγου:

  • 5.1) Τα στοιχεία στην επιλεγμένη λίστα αλληλογραφίας τοποθετούνται αυτόματα στα αντίστοιχα πεδία.
  • 5.2) Ολοκληρώστε το σώμα του email.
  • 5.3) Ελέγξτε και τα δύο Αποστολή email μέσω του Outlook και Χρησιμοποιήστε τις ρυθμίσεις υπογραφής του Outlook κουτιά?
  • 5.4) Κάντε κλικ στο Στείλετε κουμπί. Δείτε το στιγμιότυπο οθόνης:

Τώρα αποστέλλονται email. Και η προεπιλεγμένη υπογραφή του Outlook προστίθεται στο τέλος του σώματος email.

  Εάν θέλετε να έχετε μια δωρεάν δοκιμή (30-ημέρα) αυτού του βοηθητικού προγράμματος, κάντε κλικ για να το κατεβάσετεκαι μετά πηγαίνετε για να εφαρμόσετε τη λειτουργία σύμφωνα με τα παραπάνω βήματα.


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

Αποστολή email σε διευθύνσεις email που καθορίζονται σε κελιά στο Excel
Ας υποθέσουμε ότι έχετε μια λίστα διευθύνσεων email και θέλετε να στείλετε μαζικά μηνύματα ηλεκτρονικού ταχυδρομείου σε αυτές τις διευθύνσεις email απευθείας στο Excel. Πώς να το πετύχετε; Αυτό το άρθρο θα σας δείξει μεθόδους αποστολής email σε πολλές διευθύνσεις email που καθορίζονται σε κελιά στο Excel.

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

Στείλτε email με πολλά συνημμένα συνημμένα στο Excel
Αυτό το άρθρο αφορά την αποστολή email μέσω του Outlook με πολλά συνημμένα συνημμένα στο Excel.

Στείλτε email εάν έχει πληρωθεί η προθεσμία στο Excel
Για παράδειγμα, εάν η προθεσμία στη στήλη Γ είναι μικρότερη ή ίση με 7 ημέρες (η τρέχουσα ημερομηνία είναι 2017/9/13), τότε στείλτε μια υπενθύμιση μέσω email στον καθορισμένο παραλήπτη στη στήλη Α με καθορισμένο περιεχόμενο στη στήλη Β. Πώς να να το πετύχετε; Αυτό το άρθρο θα παρέχει μια μέθοδο VBA για την αντιμετώπισή της με λεπτομέρειες.

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

Περισσότερα σεμινάρια για αποστολή στο Excel ...


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

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

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

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

  • Ενεργοποίηση επεξεργασίας και ανάγνωσης καρτελών σε Word, Excel, PowerPoint, Publisher, Access, Visio και Project.
  • Ανοίξτε και δημιουργήστε πολλά έγγραφα σε νέες καρτέλες του ίδιου παραθύρου και όχι σε νέα παράθυρα.
  • Αυξάνει την παραγωγικότητά σας κατά 50% και μειώνει εκατοντάδες κλικ του ποντικιού για εσάς κάθε μέρα!
κάτω μέρος γραφείου
Σχόλια (29)
Δεν υπάρχουν ακόμη βαθμολογίες. Γίνε ο πρώτος που θα αξιολογήσετε!
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
σε ευχαριστώ πολύ, σώζεις τη ζωή μου με αυτό το πρότυπο :D
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Αγαπητέ Favio,
Ευχαρίστως να βοηθήσω.
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
δεν λειτουργεί με συνημμένα στο Office 2016
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Αγαπητέ Chris,
Ο παρακάτω κώδικας VBA μπορεί να σας βοηθήσει. Αφού εκτελέσετε τον κώδικα, επιλέξτε κελιά που περιέχουν διευθύνσεις email στις οποίες θα στείλετε email και, στη συνέχεια, επιλέξτε τα αρχεία που θέλετε να επισυνάψετε στο email ως συνημμένα όταν εμφανιστεί το δεύτερο παράθυρο διαλόγου. Και η προεπιλεγμένη υπογραφή του Outlook θα εμφανίζεται και στο σώμα του email. Σας ευχαριστούμε για το σχόλιό σας.

Sub SendEmailToAddressInCells()
Dim xRg ως εύρος
Dim xRgEach ως εύρος
Dim xRgVal ως συμβολοσειρά
Dim xAddress As String
Dim xOutApp ως Outlook.Application
Dim xMailOut ως Outlook.MailItem
On Error Συνέχιση Επόμενη
xAddress = ActiveWindow.RangeSelection.Address
Set xRg = Application.InputBox("Please select range address email", "KuTools For Excel", xAddress, , , , , 8)
Εάν το xRg δεν είναι τίποτα, τότε βγείτε από το Sub
Application.ScreenUpdating = False
Ορισμός xOutApp = CreateObject ("Outlook.Application")
Ορισμός xRg = xRg.SpecialCells(xlCellTypeConstants, xlTextValues)
Ορισμός xFileDlg = Application.FileDialog(msoFileDialogFilePicker)
Αν xFileDlg.Show = -1 Τότε
Για κάθε xRgΚάθε σε xRg
xRgVal = xRgEach.Τιμή
Αν xRgVal Like "?*@?*.?*" Τότε
Ορισμός xMailOut = xOutApp.CreateItem(olMailItem)
Με το xMailOut
.Απεικόνιση
.To = xRgVal
.Θέμα = "Δοκιμή"
.HTMLBody = "Αυτό είναι ένα δοκιμαστικό email που αποστέλλεται στο Excel" & "
" & .HTMLBody
Για κάθε xFileDlgItem Στο xFileDlg.SelectedItems
.Συνημμένα.Προσθήκη xFileDlgItem
Επόμενο xFileDlgItem
'.Στείλετε
Τέλος με
End If
Επόμενο
Ορίστε xMailOut = Τίποτα
Ρύθμιση xOutApp = Τίποτα
Application.ScreenUpdating = True
End If
Sub End
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Προσπαθώ να προσθέσω την υπογραφή του Outlook με τίτλο "προεπιλογή", αλλά δεν φαίνεται ότι λειτουργεί.
μπορείς να βοηθήσεις; Πιστεύω ότι η λογική μου "xMailout" είναι λάθος. αυτή είναι η ύποπτη ελαττωματική περιοχή μου.

Private Sub CommandButton1_Click ()

Dim xOutApp ως αντικείμενο
Dim xOutMail ως αντικείμενο
Dim xMailBody ως συμβολοσειρά
Dim xMailOut ως Outlook.MailItem
On Error Συνέχιση Επόμενη
Ορισμός xOutApp = CreateObject ("Outlook.Application")
Ορισμός xOutMail = xOutApp.CreateItem(0)
xMailBody = "Χαιρετισμοί:" & vbNewLine & vbNewLine & _
"Αυτή είναι η γραμμή 1" & vbNewLine & _
"Αυτή είναι η γραμμή 2" & vbNewLine & _
"Αυτή είναι η γραμμή 3" & vbNewLine & _
"Αυτή είναι η γραμμή 4"
On Error Συνέχιση Επόμενη
Με xOutMail
.To = "Email.here.com"
.CC = "Email.here.com"
.Subject = "Title email Here - " & Range("Cell#").value
.Body = xMailBody
. Συνημμένα.Προσθήκη ActiveWorkbook.FullName
Ορισμός xMailOut = xOutApp.CreateItem(olMailItem)
Με το xMailOut
.Απεικόνιση
Τέλος με
ActiveWorkbook. Αποθήκευση
Στο σφάλμα GoTo 0
Ορισμός xOutMail = Τίποτα
Ρύθμιση xOutApp = Τίποτα
Sub End
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Καλή σας μέρα,
Το σενάριό σας έχει τροποποιηθεί, δοκιμάστε. Σας ευχαριστώ.

Private Sub CommandButton1_Click ()
Dim xOutApp ως αντικείμενο
Dim xOutMail ως αντικείμενο
Dim xMailBody ως συμβολοσειρά
Dim xMailOut ως Outlook.MailItem
On Error Συνέχιση Επόμενη
Ορισμός xOutApp = CreateObject ("Outlook.Application")
Ορισμός xOutMail = xOutApp.CreateItem(0)
xMailBody = "Χαιρετισμοί:" & vbNewLine & vbNewLine & _
"Αυτή είναι η γραμμή 1" & vbNewLine & _
"Αυτή είναι η γραμμή 2" & vbNewLine & _
"Αυτή είναι η γραμμή 3" & vbNewLine & _
"Αυτή είναι η γραμμή 4"
On Error Συνέχιση Επόμενη
Με xOutMail
.To = "Email.here.com"
.CC = "Email.here.com"
.Subject = "Title email Here - " & Range("Cell#").Τιμή
.Body = xMailBody
.Συνημμένα.Προσθήκη ActiveWorkbook.FullName
Ορισμός xMailOut = xOutApp.CreateItem(olMailItem)
Με το xMailOut
.Απεικόνιση
Τέλος με
Τέλος με
ActiveWorkbook. Αποθήκευση
Στο σφάλμα GoTo 0
Ορισμός xOutMail = Τίποτα
Ρύθμιση xOutApp = Τίποτα
Sub End
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
πώς να προσθέσετε υπογραφή εάν η μακροεντολή χρησιμοποιείται από πολλούς χρήστες.
π.χ. η μακροεντολή μου θα τρέξει και άλλα 3 άτομα. Πώς μπορεί λοιπόν η μακροεντολή να χρησιμοποιήσει την υπογραφή του χρήστη που εκτελεί τη μακροεντολή.
ευχαριστώ εκ των προτέρων
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Καλή μέρα,
Ο κωδικός VBA μπορεί να αναγνωρίσει αυτόματα την προεπιλεγμένη υπογραφή στο Outlook του αποστολέα και να στείλει email με τη δική του υπογραφή μέσω του Outlook.
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Εάν το κύριο κείμενο μου είναι συνδεδεμένο με έλξη από πεδία excel, η χρήση του & .HTMLBody στο τέλος της συμβολοσειράς διαγράφει όλο το κύριο κείμενο και απλώς αφήνει την υπογραφή.
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Αντιμετωπίζω πρόβλημα με την εκτέλεση αυτού στο excel 2016. Λαμβάνω ένα μήνυμα "Σφάλμα μεταγλώττισης: Καθορισμένος από τον χρήστη Τύπος δεν ορίζεται". Παρακαλώ βοηθήστε!
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Υπέροχος!!!!
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Thanks a lot ...
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Γεια, θα χρειαζόμουν βοήθεια με τη μακροεντολή μου, πρέπει να εισαγάγω την υπογραφή του Outlook κάτω από τον πίνακα, μπορείτε να με βοηθήσετε με αυτό;

Private Sub CommandButton1_Click ()


Dim outlook ως αντικείμενο
Σίγαση του νέου μηνύματος ηλεκτρονικού ταχυδρομείου ως αντικείμενο
Dim xInspect As Object
Dim pageEditor ως αντικείμενο

Ορισμός outlook = CreateObject ("Outlook.Application")
Ορισμός newEmail = outlook.CreateItem(0)

Με νέο email
.To = Sheet5.Range("F1")
.CC = ""
.BCC = ""
.Subject = Sheet5.Range("B5")
.Body = Sheet5.Range("B41")
.απεικόνιση

Ορίστε xInspect = newEmail.GetInspector
Ορισμός pageEditor = xInspect.WordEditor

Sheet5.Range("B6:I7").Αντιγραφή

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

.απεικόνιση
Ορισμός pageEditor = Τίποτα
Ορισμός xInspect = Τίποτα
Τέλος με

Ορισμός newEmail = Τίποτα
Ορισμός προοπτικής = Τίποτα

Sub End
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Γεια σου Μπάρα,
Συγγνώμη δεν μπορώ να σε βοηθήσω με αυτό. Ευχαριστώ για το σχόλιο σου.
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Αγαπητοί,
Μπορεί κάποιος να με βοηθήσει με το VBA μου,
Χρειάζομαι την υπογραφή στο email που δημιουργήθηκε:
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Χάρη σε εσάς, μπορώ να προσθέσω υπογραφή τώρα, αλλά στη συνέχεια αφαιρεί τα κενά μεταξύ της παραγράφου του κειμένου. Παρακαλώ μπορείτε να με βοηθήσετε ?


Sub helloworld()
Dim OutApp ως αντικείμενο
Dim OutMail ως αντικείμενο
Θαμπό κελί ως εύρος
Dim Path As String
Path = Application.ActiveWorkbook.Path
Ορισμός OutApp = CreateObject ("Outlook.Application")

Για κάθε κελί στο εύρος ("C4:C6")
Ορισμός OutMail = OutApp.CreateItem(0)
Με OutMail
.Απεικόνιση
.To = κελί.Τιμή
.Subject = Κελιά(κελί.Σειρά, "D").Τιμή
.HTMLBody = "Dear " & Cells(cell.Row, "B").Τιμή & "," _
& vbNewLine & vbNewLine & _
"Θερμοί χαιρετισμοί" _
& vbNewLine & vbNewLine & _
"Εμείς, η JK Overseas, θα θέλαμε να εκμεταλλευτούμε την ευκαιρία και να παρουσιάσουμε την εταιρεία μας JK Overseas, η οποία δραστηριοποιείται στον κλάδο του αλατιού τα τελευταία 3 χρόνια. Αυτήν τη στιγμή είμαστε ισχυροί στην εγχώρια αγορά και στην επέκταση στο εξωτερικό. Είμαστε ο προμηθευτής βρώσιμου αλατιού, Αλάτι αποσκλήρυνσης νερού, αλάτι αποπάγωσης, βιομηχανικό αλάτι" & "." _
& vbNewLine & vbNewLine & _
"Έχουμε δεσμό με κατασκευαστές μεγάλης κλίμακας στην Ινδία και προμηθεύουμε από αυτούς ποιοτικό αλάτι και εξάγουμε. Επομένως, αναζητούμε έναν αξιόπιστο έμπειρο εισαγωγέα καθώς και αντιπρόσωπο διανομέα για να δημιουργήσουμε μια μακροπρόθεσμη επιχείρηση με αμοιβαίο όφελος" & " ." _
& vbNewLine & vbNewLine & _
"Επικοινωνήστε μαζί μας για την απαίτησή σας ή για οποιαδήποτε άλλη απορία έχετε. Παρέχουμε αξιόπιστη υλικοτεχνική υποστήριξη και έγκαιρη παράδοση. Είμαστε βέβαιοι ότι οι πιο ανταγωνιστικές τιμές μας θα ανταποκρίνονται στις προσδοκίες σας" & "." _
& vbNewLine & vbNewLine & _
.HTMLΣώμα

'.Στείλετε
Τέλος με
Επόμενο κελί
Sub End
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Προσπαθώ να ενσωματώσω αυτόν τον κώδικα στην τρέχουσα μορφή που έχω αυτήν τη στιγμή, με την οποία μπορώ να αυτοματοποιήσω τα μηνύματα ηλεκτρονικού ταχυδρομείου εντός του excel με βάση ένα σύνολο τιμών. Οποιαδήποτε βοήθεια σχετικά με το πού να προσθέσω τον κωδικό «υπογραφής» σε αυτό που έχω αυτή τη στιγμή θα εκτιμούσα πολύ.

Public Sub CheckAndSendMail()

«Ενημερώθηκε από Extendoffice 2018 / 11 / 22

Dim xRgDate ως εύρος

Dim xRgΑποστολή ως εύρος

Μείωση xRgText ως εύρος

Dim xRgDone As Range

Dim xOutApp ως αντικείμενο

Dim xMailItem ως αντικείμενο

Dim xLastRow As Long

Dim vbCrLf ως συμβολοσειρά

Dim xMailBody ως συμβολοσειρά

Dim xRgDateVal ως συμβολοσειρά

Dim xRgSendVal ως συμβολοσειρά

Dim xMailSubject ως συμβολοσειρά

Dim I As Long

On Error Συνέχιση Επόμενη

«Προσδιορίστε το εύρος ημερομηνιών λήξης

xStrRang = "D2:D110"

Ορισμός xRgDate = Range(xStrRang)

«Προσδιορίστε το εύρος των διευθύνσεων email των παραληπτών

xStrRang = "C2:C110"

Ορισμός xRgSend = Εύρος (xStrRang)

xStrRang = "A2:A110"

Ορισμός xRgName = Εύρος (xStrRang)

«Καθορίστε το εύρος με το υπενθυμισμένο περιεχόμενο στο email σας

xStrRang = "Z2:Z110"

Ορισμός xRgText = Εύρος (xStrRang)

xLastRow = xRgDate.Rows.Count

Ορισμός xRgDate = xRgDate(1)

Ορισμός xRgSend = xRgSend(1)

Ορισμός xRgName = xRgName(1)

Ορισμός xRgText = xRgText(1)

Ορισμός xOutApp = CreateObject ("Outlook.Application")

Για I = 1 έως xLastRow

xRgDateVal = ""

xRgDateVal = xRgDate.Offset(I - 1).Τιμή

Αν xRgDateVal <> "" Τότε

Αν CDate(xRgDateVal) - Ημερομηνία <= 30 Και CDate(xRgDateVal) - Ημερομηνία > 0 Τότε

xRgSendVal = xRgSend.Offset(I - 1).Τιμή

xMailSubject = " Συμφωνία υπηρεσιών JBC που λήγει στις " & xRgDateVal

vbCrLf = "

"

xMailBody = ""

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

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

xMailBody = xMailBody & ""

Ορισμός xMailItem = xOutApp.CreateItem(0)

Με το xMailItem

.Subject = xMailSubject

.To = xRgSendVal

.CC = "mailcc@justbettercare.com"

.HTMLBody = xMailBody

.Απεικόνιση

'.Στείλετε

Τέλος με

Ορισμός xMailItem = Τίποτα

End If

End If

Επόμενο

Ρύθμιση xOutApp = Τίποτα

Sub End
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Είναι πραγματικά χρήσιμος κώδικας
Πρέπει να αλλάξω τη μορφή κειμένου από δεξιά προς τα αριστερά Στη γραμμή xOutMsg
βοήθεια παρακαλώ .
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Προσπαθώ να στείλω μεμονωμένα φύλλα από το excel σε διαφορετικά email, αλλά θα επισυνάψει μόνο το ίδιο το βιβλίο εργασίας. Επίσης, πρέπει να μπορώ να προσθέσω τη γραμμή υπογραφής μου. Κάποια βοήθεια; Sub AST_Email_From_Excel()

Dim emailApplication As Object
Dim emailItem as Object

Ορισμός emailApplication = CreateObject ("Outlook.Application")
Ορισμός emailItem = emailApplication.CreateItem(0)

Τώρα φτιάχνουμε το email.

emailItem.to = Εύρος ("e2").Τιμή

emailItem.CC = Εύρος ("g2").Τιμή

emailItem.Subject = "Μη επιστρεφόμενος εξοπλισμός Techquidation"

emailItem.Body = "Δείτε το συνημμένο υπολογιστικό φύλλο για στοιχεία που δεν έχουν επιστραφεί στην περιοχή σας"

«Επισύναψη τρέχοντος βιβλίου εργασίας
emailItem.Attachments.Add ActiveWorkbook.FullName

«Επισυνάψτε οποιοδήποτε αρχείο από τον υπολογιστή σας.
'emailItem.Attachments.Add ("C:\...)"

«Στείλτε το email
'emailItem.send

«Εμφανίστε το email ώστε ο χρήστης να μπορεί να το αλλάξει όπως επιθυμεί πριν από την αποστολή
emailItem.Εμφάνιση

Ορισμός emailItem = Τίποτα
Ορισμός emailApplication = Τίποτα

Sub End
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Γεια σου Chris, Ο κωδικός που παρείχες έχει τροποποιηθεί. Η υπογραφή του Outlook μπορεί τώρα να εισαχθεί στο σώμα του μηνύματος. Δοκιμάστε το. Σας ευχαριστώ. Sub AST_Email_From_Excel()
«Ενημερώθηκε από Extendoffice 20220211
Dim emailApplication As Object
Dim emailItem as Object
Ορισμός emailApplication = CreateObject ("Outlook.Application")
Ορισμός emailItem = emailApplication.CreateItem(0)

Τώρα φτιάχνουμε το email.
emailItem.Display «Εμφανίστε το email ώστε ο χρήστης να μπορεί να το αλλάξει όπως επιθυμεί πριν από την αποστολή
emailItem.to = Εύρος ("e2").Τιμή
emailItem.CC = Εύρος ("g2").Τιμή
emailItem.Subject = "Μη επιστρεφόμενος εξοπλισμός Techquidation"
emailItem.HTMLBody = "Δείτε το συνημμένο υπολογιστικό φύλλο για στοιχεία που δεν έχουν επιστραφεί στην περιοχή σας" & " " & emailItem.HTMLBody

«Επισύναψη τρέχοντος βιβλίου εργασίας
emailItem.Attachments.Add ActiveWorkbook.FullName

Ορισμός emailItem = Τίποτα
Ορισμός emailApplication = Τίποτα

Sub End
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Γεια σου Crystal, Ευχαριστούμε που το έβαλες να προσθέσει την υπογραφή, δεν φαίνεται να αρέσει η ενότητα HTMLBody όμως. Όταν εκτελώ τη μακροεντολή, γίνεται εντοπισμός σφαλμάτων στο emailItem.HTMLBody = "Δείτε το συνημμένο υπολογιστικό φύλλο για στοιχεία που δεν έχουν επιστραφεί στην περιοχή σας" & " " & emailItem.HTMLBodyκαι δεν ολοκληρώνει τα υπόλοιπα.  
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Γεια σας,
Ποια έκδοση του Excel χρησιμοποιείτε; Ο παρακάτω κώδικας VBA μπορεί επίσης να βοηθήσει. Δοκιμάστε το. Ευχαριστούμε για την ανταπόκριση σας. Sub SendWorkSheet()
«Ενημέρωση από Extendoffice 20220218
Dim xFile ως συμβολοσειρά
Dim xFormat As Long
Dim Wb ως βιβλίο εργασίας
Dim Wb2 ως βιβλίο εργασίας
Dim FilePath ως συμβολοσειρά
Dim FileName As String
Εξασθένιση του OutlookApp ως αντικείμενο
Εξασθένιση του OutlookMail ως αντικείμενο
On Error Συνέχιση Επόμενη
Application.ScreenUpdating = False
Ορισμός Wb = Application.ActiveWorkbook
ActiveSheet.Αντιγραφή
Ορισμός Wb2 = Application.ActiveWorkbook
Επιλέξτε Case Wb.FileFormat
Περίπτωση xlOpenXMLWorkbook:
xFile = ".xlsx"
xFormat = xlOpenXMLWorkbook
Περίπτωση xlOpenXMLWorkbookMacroEnabled:
Αν Wb2.HasVBProject Τότε
xFile = ".xlsm"
xFormat = xlOpenXMLWorkbookMacroEnabled
Αλλού
xFile = ".xlsx"
xFormat = xlOpenXMLWorkbook
End If
Περίπτωση Excel8:
xFile = ".xls"
xFormat = Excel8
Περίπτωση xlExcel12:
xFile = ".xlsb"
xFormat = xlExcel12
Επιλέξτε Τερματισμός
FilePath = Environ$("temp") & "\"
FileName = Wb.Name & Format (Τώρα, "ηη-μμμ-εε ω-μμ-δδ")
Ορισμός OutlookApp = CreateObject ("Outlook.Application")
Ορισμός OutlookMail = OutlookApp.CreateItem(0)
Wb2.SaveAs FilePath & FileName & xFile, FileFormat:=xFormat
'xstr = Εύρος ("e2") & " ; " & Εύρος ("g2")
Με το OutlookMail
.Απεικόνιση
.To = Εύρος ("e2")
.CC = Εύρος ("g2")
.BCC = ""
.Subject = "Μη επιστρεφόμενος εξοπλισμός Techquidation"
.HTMLBody = "Δείτε το συνημμένο υπολογιστικό φύλλο για στοιχεία που δεν έχουν επιστραφεί στην περιοχή σας" & " " & .HTMLBody
.Συνημμένα.Προσθήκη Wb2.FullName
'.Στείλετε
Τέλος με
Wb2.Κλείσιμο
Kill FilePath & FileName & xFile
Ορισμός OutlookMail = Τίποτα
Ορισμός OutlookApp = Τίποτα
Application.ScreenUpdating = True
Sub End
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Φαίνεται να είναι Excel 2016 και VBA 7.1
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Oi Cristal, ένα minha macro perde a configuração da assinatura do e-mail, com imagens e formatação original. Επιλύτης Como consigo;

Sub Geraremail()

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

Ορίστε OLapp = Νέο Outlook.Application
Ορισμός janela = OLapp.CreateItem(olMailItem)

Arquivo01 = "Χάρτης AN"
Anexo01 = ThisWorkbook.Path & "\" & Arquivo01 & ".xlsm"


Με τη Τζανέλα
ActiveWorkbook. Αποθήκευση
.Απεικόνιση
.To = Sheets("Base").Range("A2").Value
.CC = Φύλλα ("Βάση").Εύρος ("A5").Τιμή
.Subject = "Mapa - Acrilo " & Format(Ημερομηνία, "dd.mm.yy")
assinatura = .Σώμα
.Body = "Prezados/as," & Chr(10) & Chr(10) & "Segue anexo o mapa de Acrilonitrila considerando as vendas previstas no S&OP." & Chr(10) & Chr(10) & assinatura
.Συνημμένα.Προσθήκη Anexo01
Τέλος με

Sub End
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Com a mudança abaixo, consegui ajustar. Porém a letra do corpo da mensagem fica em Times New Roman. Gostaria de usar Calibri, como posso alterar o código;

Sub Geraremail()

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

Ορίστε OLapp = Νέο Outlook.Application
Ορισμός janela = OLapp.CreateItem(olMailItem)

Arquivo01 = "Χάρτης AN"
Anexo01 = ThisWorkbook.Path & "\" & Arquivo01 & ".xlsm"


Με τη Τζανέλα
ActiveWorkbook. Αποθήκευση
.Απεικόνιση
.To = Sheets("Base").Range("A2").Value
.CC = Φύλλα ("Βάση").Εύρος ("A5").Τιμή
.Subject = "Mapa - Acrilo " & Format(Ημερομηνία, "dd.mm.yy")
assinatura = .Σώμα
.HTMLBody = "Prezados/as," & Chr(10) & Chr(10) & "Segue anexo o mapa de Acrilonitrila θεωρείται ως vendas previstas no S&OP." &" " & .HTMLBody
.Συνημμένα.Προσθήκη Anexo01
Τέλος με

Sub End
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Γεια σου Milla,
Ο παρακάτω κώδικας VBA μπορεί να σας βοηθήσει να αλλάξετε τη γραμματοσειρά του σώματος του email σε Calibri, δοκιμάστε το. Ευχαριστώ.
Πριν εκτελέσετε τον κώδικα, πρέπει να κάνετε κλικ Εργαλεία > Αναφορά στο Microsoft Visual Basic για εφαρμογές παράθυρο και, στη συνέχεια, ελέγξτε το Βιβλιοθήκη αντικειμένων του Microsoft Word στο πλαίσιο ελέγχου Αναφορές - VBAProject παράθυρο διαλόγου όπως το στιγμιότυπο οθόνης που φαίνεται παρακάτω.
[img]I:\工作\周雪明\2022年工作\6月份\文章评论截图\3.png[/img]
Sub Geraremail()
Dim OLapp As Outlook.Application
Dim janela As Outlook.MailItem
Dim xDoc As Document 'Click Tools > Reference to enable the Microsoft Word Object Library
On Error Resume Next
Set OLapp = New Outlook.Application
Set janela = OLapp.CreateItem(olMailItem)
Arquivo01 = "Mapa AN"
Anexo01 = ThisWorkbook.Path & "\" & Arquivo01 & ".xlsm"
With janela
  ActiveWorkbook.Save
  .Display
  .To = Sheets("Base").Range("A2").Value
  .CC = Sheets("Base").Range("A5").Value
  .Subject = "Mapa - Acrilo " & Format(Date, "dd.mm.yy")
   assinatura = .Body
  .HTMLBody = "Prezados/as," & Chr(10) & Chr(10) & "Segue anexo o mapa de Acrilonitrila considerando as vendas previstas no S&OP." & "<br>" & .HTMLBody
  .Attachments.Add Anexo01
End With
Set xDoc = janela.GetInspector.WordEditor
xDoc.Content.Font.Name = "Calibri"
End Sub
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Γεια σου Milla,
Ο παρακάτω κώδικας VBA μπορεί να σας βοηθήσει να αλλάξετε τη γραμματοσειρά του σώματος του email σε Calibri, δοκιμάστε το. Ευχαριστώ.
Πριν εκτελέσετε τον κώδικα, πρέπει να κάνετε κλικ Εργαλεία > Αναφορά στο Microsoft Visual Basic για εφαρμογές παράθυρο και, στη συνέχεια, ελέγξτε το Βιβλιοθήκη αντικειμένων του Microsoft Word στο πλαίσιο ελέγχου Αναφορές - VBAProject παράθυρο διαλόγου όπως το συνημμένο αρχείο που φαίνεται παρακάτω.
Sub Geraremail()
Dim OLapp As Outlook.Application
Dim janela As Outlook.MailItem
Dim xDoc As Document 'Click Tools > Reference to enable the Microsoft Word Object Library
On Error Resume Next
Set OLapp = New Outlook.Application
Set janela = OLapp.CreateItem(olMailItem)
Arquivo01 = "Mapa AN"
Anexo01 = ThisWorkbook.Path & "\" & Arquivo01 & ".xlsm"
With janela
  ActiveWorkbook.Save
  .Display
  .To = Sheets("Base").Range("A2").Value
  .CC = Sheets("Base").Range("A5").Value
  .Subject = "Mapa - Acrilo " & Format(Date, "dd.mm.yy")
   assinatura = .Body
  .HTMLBody = "Prezados/as," & Chr(10) & Chr(10) & "Segue anexo o mapa de Acrilonitrila considerando as vendas previstas no S&OP." & "<br>" & .HTMLBody
  .Attachments.Add Anexo01
End With
Set xDoc = janela.GetInspector.WordEditor
xDoc.Content.Font.Name = "Calibri"
End Sub
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Γεια σας, προσπαθώ να διορθώσω τον κώδικα VBA μου. Θα ήθελα να συμπεριλάβω μια από τις υπογραφές μου στο Outlook με ένα λογότυπο. Είναι δυνατό αυτό και πού μπορώ να τοποθετήσω τον κώδικα που χρησιμοποιώ αυτήν τη στιγμή; Οποιαδήποτε βοήθεια θα ήταν μεγάλη.

Sub EmailAspdf()

Dim EApp ως αντικείμενο
Ορισμός EApp = CreateObject ("Outlook.Application")

Dim EItem ως αντικείμενο
Ορισμός EItem = EApp.CreateItem(0)

Dim invno As Long
Dim custname As String
Dim amt ως νόμισμα
Dim dt_issue As Date
Ασθενής όρος ως Byte
Dim nextrec As Range
Αχνό μονοπάτι As String
Dim fname As String

invno = Εύρος ("I4")
custname = Εύρος ("A11")
amt = Εύρος ("I42")
dt_issue = Εύρος ("I6")
όρος = Εύρος ("I7")
μονοπάτι = "mypath"
fname = invno & " - " & custname

ActiveSheet.ExportAsFixedFormat Τύπος:=xlTypePDF, IgnorePrintAreas:=False, Όνομα αρχείου:=διαδρομή & όνομα f

Ορισμός nextrec = Sheet3.Range("A1048576").End(xlUp).Offset(1, 0)

nextrec = invno
nextrec.Offset(0, 1) = όνομα πελάτη
nextrec.Offset(0, 2) = amt
nextrec.Offset(0, 3) = dt_issue
nextrec.Offset(0, 4) = dt_issue + όρος
nextrec.Offset(0, 8) = Τώρα

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

Με EItem

.To = Εύρος ("A17")

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

.body = "Hello " & Range("A11") & "," & vbNewLine & vbNewLine _
& "Δείτε το συνημμένο τιμολόγιο για " & Range("A11") & "." & vbNewLine & vbNewLine _
& "Αν έχετε οποιεσδήποτε ερωτήσεις, μη διστάσετε να επικοινωνήσετε μαζί μου." & vbNewLine & vbNewLine _
& "Best," & vbNewLine _
& "Mynamehere" & vbNewLine

.Attachments.Add (διαδρομή & fname & ".pdf")

.Απεικόνιση

Τέλος με
Έξοδος Sub



Sub End
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Γεια σου RoseAnne,

Μπορείτε να προσθέσετε χειροκίνητα το λογότυπο στην υπογραφή σας εκ των προτέρων πριν εφαρμόσετε τον κώδικα VBA. Ο κώδικας πρέπει να τοποθετηθεί στο παράθυρο κώδικα μονάδας (πατήστε το συνδυασμό πλήκτρων Alt + F11 για να ανοίξετε το πρόγραμμα επεξεργασίας της Visual Basic, κάντε κλικ στην επιλογή Εισαγωγή > Μονάδα)
Δεν υπάρχουν σχόλια δημοσιεύτηκε ακόμα
Αφήστε τα σχόλιά σας
Δημοσίευση ως επισκέπτης
×
Αξιολογήστε αυτήν την ανάρτηση:
0   Χαρακτήρες
Προτεινόμενες τοποθεσίες

Ακολουθησε μας

Πνευματικά δικαιώματα © 2009 - www.extendoffice.com. | Ολα τα δικαιώματα διατηρούνται. Τροφοδοτείται από ExtendOffice. | Sitemap
Το Microsoft και το λογότυπο του Office είναι εμπορικά σήματα ή σήματα κατατεθέντα της Microsoft Corporation στις Ηνωμένες Πολιτείες ή / και σε άλλες χώρες.
Προστατεύεται από το Sectigo SSL