Εάν θέλετε το Outlook να εξάγει αυτόματα και να αποθηκεύει τις ενσωματωμένες εικόνες από τα συγκεκριμένα εισερχόμενα μηνύματα ηλεκτρονικού ταχυδρομείου, μπορείτε να ανατρέξετε σε αυτό το άρθρο. Εδώ θα σας μάθουμε πώς να το πραγματοποιήσετε με κώδικα VBA.
Ορισμένοι χρήστες χρειάζεται συχνά να εξάγουν τις ενσωματωμένες εικόνες από τα συγκεκριμένα εισερχόμενα μηνύματα ηλεκτρονικού ταχυδρομείου και να τις αποθηκεύουν σε έναν συγκεκριμένο φάκελο των Windows. Είναι τόσο ενοχλητικό να το κάνετε χειροκίνητα κάθε φορά. Επομένως, πολλοί ανυπομονούν να μάθουν μια γρήγορη και βολική προσέγγιση για να επιτρέψουν στο Outlook να το επιτύχει αυτόματα. Τώρα, εδώ θα μοιραστούμε μια τέτοια μέθοδο μαζί σας.
Αυτόματη εξαγωγή ενσωματωμένων εικόνων από συγκεκριμένα εισερχόμενα μηνύματα ηλεκτρονικού ταχυδρομείου
- Αρχικά, ξεκινήστε το πρόγραμμα Outlook ως συνήθως.
- Στη συνέχεια, ενεργοποιήστε τον επεξεργαστή Outlook VBA ως συνήθως με αναφορά t "Τρόπος εκτέλεσης κώδικα VBA στο Outlook".
- Αργότερα, αντιγράψτε και επικολλήστε τον ακόλουθο κώδικα VBA στο έργο "ThisOutlookSession".
Public WithEvents objInbox As Outlook.Folder
Public WithEvents objInboxItems As Outlook.Items
Private Sub Application_Startup()
Set objInbox = Outlook.Application.Session.GetDefaultFolder(olFolderInbox)
Set objInboxItems = objInbox.Items
End Sub
Private Sub objInboxItems_ItemAdd(ByVal Item As Object)
Dim objMail As Outlook.MailItem
Dim objAttachments As Outlook.Attachments
Dim objAttachment As Outlook.Attachment
Dim strWindowsFolder As String
Dim i As Long
If TypeOf Item Is MailItem Then
Set objMail = Item
'Specify the emails as per your needs
If objMail.Importance = olImportanceHigh Then
Set objAttachments = objMail.Attachments
'Specify the windows folder
strWindowsFolder = "E:\" & objMail.Subject & Format(Now, "yymmddhhmmss")
MkDir (strWindowsFolder)
'Save all embedded images to the folder
For i = 1 To objAttachments.Count
Set objAttachment = objAttachments.Item(i)
If IsEmbedded(objAttachment) = True Then
objAttachment.SaveAsFile strWindowsFolder & "\" & objAttachment.FileName
End If
Next
End If
End If
End Sub
Function IsEmbedded(objCurAttachment As Outlook.Attachment) As Boolean
Dim objPropertyAccessor As Outlook.PropertyAccessor
Dim strProperty As String
Set objPropertyAccessor = objCurAttachment.PropertyAccessor
strProperty = objPropertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/proptag/0x3712001E")
If InStr(1, strProperty, "@") > 0 Then
IsEmbedded = True
Else
IsEmbedded = False
End If
End Function
- Στη συνέχεια, κάντε κλικ στην υπορουτίνα "Application_Startup".
- Τέλος, κάντε κλικ στο πλήκτρο "F5" για να ενεργοποιήσετε αυτήν τη μακροεντολή.
- Από εδώ και στο εξής, κάθε φορά που φθάνει ένα συγκεκριμένο νέο email στα Εισερχόμενα, οι ενσωματωμένες εικόνες θα αποθηκεύονται στον συγκεκριμένο φάκελο των Windows, όπως φαίνεται στο παρακάτω στιγμιότυπο οθόνης.
Καθαρίζετε τακτικά τα μεγάλα προσαρτήματα
Συνιστάται να καθαρίζετε τα μεγάλα συνημμένα από το Outlook σας σε τακτική βάση. Στόχος είναι να διατηρείτε το αρχείο Outlook σας στο κατάλληλο μέγεθος. Τα μεγαλύτερα αρχεία Outlook είναι πιο ευάλωτα σε αλλοίωση. Όπως γνωρίζετε, η ζημιά στο PST είναι αρκετά δύσκολο να αντιμετωπιστεί σωστά. Ίσως πρώτα να προσπαθήσετε να την διορθώσετε μέσω του εργαλείου επιδιόρθωσης εισερχομένων. Ωστόσο, στις περισσότερες περιπτώσεις, δεν θα λειτουργήσει. Η μόνη σας λύση είναι ένα εξειδικευμένο εργαλείο. Επισκευή PST εργαλείο, όπως DataNumen Outlook Repair, ή σχετικές υπηρεσίες επαγγελματικής αποκατάστασης.
Εισαγωγή συγγραφέα:
Η Shirley Zhang είναι ειδικός ανάκτησης δεδομένων στο DataNumen, Inc., η οποία είναι ο παγκόσμιος ηγέτης στις τεχνολογίες ανάκτησης δεδομένων, συμπεριλαμβανομένων διόρθωση MDF και προϊόντα λογισμικού επισκευής προοπτικών. Για περισσότερες πληροφορίες επισκεφθείτε www.datanumen.com