Conas gach bileog a sheoladh chuig seoltaí ríomhphoist éagsúla ó Excel?
Má tá leabhar oibre agat le roinnt bileoga oibre, agus tá seoladh ríomhphoist i gcill A1 de gach bileog. Anois, ba mhaith leat gach bileog a sheoladh ón leabhar oibre mar cheangaltán chuig faighteoir comhfhreagrach i gcill A1 ina n-aonar. Conas a d'fhéadfá an tasc seo a réiteach in Excel? An t-alt seo, tabharfaidh mé isteach cód VBA chun gach bileog a sheoladh mar cheangaltán chuig seoladh ríomhphoist éagsúla ó Excel.
Seol gach bileog chuig seoltaí ríomhphoist éagsúla ó Excel le cód VBA
Is féidir leis an gcód VBA seo a leanas cabhrú leat gach bileog a sheoladh mar cheangaltán chuig faighteoirí éagsúla, déan mar seo le do thoil:
1. Brúigh Alt + F11 eochracha ag an am céanna chun an Microsoft Visual Basic d’Fheidhmchláir fhuinneog.
2. Ansin, cliceáil Ionsáigh > Modúil, agus cóipeáil agus greamaigh an cód VBA thíos isteach sa fhuinneog.
Cód VBA: Seol gach bileog mar cheangaltán chuig seoltaí ríomhphoist éagsúla
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 an bhfuil an seoladh ríomhphoist sa chill ar mian leat an ríomhphost a sheoladh chuige. Athraigh iad chuig do riachtanas le do thoil.
- Is féidir leat an CC, BCC, Ábhar, Comhlacht le do chuid féin a shonrú sa chód;
- Chun an ríomhphost a sheoladh go díreach gan an fhuinneog teachtaireachta nua seo a leanas a oscailt, ní mór duit é a athrú .Dráma chun .Seol.
3. Ansin, brúigh F5 eochair chun an cód seo a rith, agus cuirtear gach bileog isteach sa fhuinneog teachtaireachta nua mar cheangaltán go huathoibríoch, féach an scáileán scáileáin:
4. Ar deireadh, ní mór duit ach cliceáil Seol cnaipe chun gach ríomhphost a sheoladh ceann ar cheann.
Uirlisí Táirgiúlachta Oifige is Fearr
Supercharge Do Scileanna Excel le Kutools le haghaidh Excel, agus Éifeachtúlacht Taithí Cosúil Ná Roimhe. Kutools le haghaidh Excel Tairiscintí Níos mó ná 300 Ardghnéithe chun Táirgiúlacht a Treisiú agus Sábháil Am. Cliceáil anseo chun an ghné is mó a theastaíonn uait a fháil ...
Tugann Tab Oifige comhéadan Tabbed chuig Office, agus Déan Do Obair i bhfad Níos Éasca
- Cumasaigh eagarthóireacht agus léamh tabbed i Word, Excel, PowerPoint, Foilsitheoir, Rochtain, Visio agus Tionscadal.
- Oscail agus cruthaigh cáipéisí iolracha i gcluaisíní nua den fhuinneog chéanna, seachas i bhfuinneoga nua.
- Méadaíonn do tháirgiúlacht 50%, agus laghdaíonn sé na céadta cad a tharlaíonn nuair luch duit gach lá!
