एक्सेल से प्रत्येक शीट को अलग-अलग ईमेल पते पर कैसे भेजें?
यदि आपके पास कई वर्कशीट वाली कार्यपुस्तिका है, और प्रत्येक शीट के सेल A1 में एक ईमेल पता है। अब, आप कार्यपुस्तिका से प्रत्येक शीट को व्यक्तिगत रूप से सेल A1 में संबंधित प्राप्तकर्ता को अनुलग्नक के रूप में भेजना चाहते हैं। आप एक्सेल में इस कार्य को कैसे हल कर सकते हैं? इस लेख में, मैं प्रत्येक शीट को एक्सेल से अलग-अलग ईमेल पते पर अनुलग्नक के रूप में भेजने के लिए एक वीबीए कोड पेश करूंगा।
प्रत्येक शीट को वीबीए कोड के साथ एक्सेल से अलग-अलग ईमेल पते पर भेजें
निम्नलिखित वीबीए कोड आपको प्रत्येक शीट को विभिन्न प्राप्तकर्ताओं को अनुलग्नक के रूप में भेजने में मदद कर सकता है, कृपया ऐसा करें:
1। दबाएँ ऑल्ट + एफ 11 खोलने के लिए एक साथ कुंजियाँ अनुप्रयोगों के लिए माइक्रोसॉफ्ट विज़ुअल बेसिक खिड़की.
2। तब दबायें सम्मिलित करें > मॉड्यूल, और नीचे दिए गए VBA कोड को कॉपी करके विंडो में पेस्ट करें।
वीबीए कोड: प्रत्येक शीट को अलग-अलग ईमेल पते पर अनुलग्नक के रूप में भेजें
Sub Mail_Every_Worksheet()
'Updateby ExtendOffice
Dim xWs As Worksheet
Dim xWb As Workbook
Dim xFileExt As String
Dim xFileFormatNum As Long
Dim xTempFilePath As String
Dim xFileName As String
Dim xOlApp As Object
Dim xMailObj As Object
On Error Resume Next
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
xTempFilePath = Environ$("temp") & "\"
If Val(Application.Version) < 12 Then
xFileExt = ".xls": xFileFormatNum = -4143
Else
xFileExt = ".xlsm": xFileFormatNum = 52
End If
Set xOlApp = CreateObject("Outlook.Application")
For Each xWs In ThisWorkbook.Worksheets
If xWs.Range("S1").Value Like "?*@?*.?*" Then
xWs.Copy
Set xWb = ActiveWorkbook
xFileName = xWs.Name & " of " _
& VBA.Left(ThisWorkbook.Name, VBA.InStr(ThisWorkbook.Name, ".") - 1) & " "
Set xMailObj = xOlApp.CreateItem(0)
xWb.Sheets.Item(1).Range("S1").Value = ""
With xWb
.SaveAs xTempFilePath & xFileName & xFileExt, FileFormat:=xFileFormatNum
With xMailObj
'specify the CC, BCC, Subject, Body below
.To = xWs.Range("S1").Value
.CC = ""
.BCC = ""
.Subject = "This is the Subject line"
.Body = "Hi there"
.Attachments.Add xWb.FullName
.Display
End With
.Close SaveChanges:=False
End With
Set xMailObj = Nothing
Kill xTempFilePath & xFileName & xFileExt
End If
Next
Set xOlApp = Nothing
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub
- S1 क्या सेल में वह ईमेल पता है जिस पर आप ईमेल भेजना चाहते हैं। कृपया उन्हें अपनी आवश्यकता के अनुसार बदलें।
- आप कोड में सीसी, बीसीसी, विषय, निकाय को निर्दिष्ट कर सकते हैं;
- निम्नलिखित नई संदेश विंडो खोले बिना सीधे ईमेल भेजने के लिए, आपको बदलना होगा प्रदर्शन सेवा मेरे ।भेजना.
3। फिर दबायें F5 इस कोड को चलाने के लिए कुंजी, और प्रत्येक शीट स्वचालित रूप से अनुलग्नक के रूप में नई संदेश विंडो में डाली जाती है, स्क्रीनशॉट देखें:
4. अंत में, आपको बस क्लिक करना होगा भेजें प्रत्येक ईमेल को एक-एक करके भेजने के लिए बटन।
सर्वोत्तम कार्यालय उत्पादकता उपकरण
एक्सेल के लिए कुटूल के साथ अपने एक्सेल कौशल को सुपरचार्ज करें, और पहले जैसी दक्षता का अनुभव करें। एक्सेल के लिए कुटूल उत्पादकता बढ़ाने और समय बचाने के लिए 300 से अधिक उन्नत सुविधाएँ प्रदान करता है। वह सुविधा प्राप्त करने के लिए यहां क्लिक करें जिसकी आपको सबसे अधिक आवश्यकता है...
ऑफिस टैब ऑफिस में टैब्ड इंटरफ़ेस लाता है, और आपके काम को बहुत आसान बनाता है
- Word, Excel, PowerPoint में टैब्ड संपादन और रीडिंग सक्षम करें, प्रकाशक, एक्सेस, विसियो और प्रोजेक्ट।
- नई विंडो के बजाय एक ही विंडो के नए टैब में एकाधिक दस्तावेज़ खोलें और बनाएं।
- आपकी उत्पादकता 50% बढ़ जाती है, और आपके लिए हर दिन सैकड़ों माउस क्लिक कम हो जाते हैं!
