Ինչպե՞ս ուղարկել յուրաքանչյուր թերթ Excel-ից տարբեր էլփոստի հասցեներ:

Եթե ​​ունեք աշխատանքային գրքույկ մի քանի աշխատաթերթերով, և յուրաքանչյուր թերթի A1 բջիջում կա էլփոստի հասցե: Այժմ դուք ցանկանում եք յուրաքանչյուր թերթիկ ուղարկել աշխատանքային գրքույկից որպես կցորդ A1 բջիջի համապատասխան ստացողին առանձին: Ինչպե՞ս կարող եք լուծել այս խնդիրը Excel-ում: Այս հոդվածում ես կներկայացնեմ VBA կոդ՝ յուրաքանչյուր թերթիկ որպես հավելված Excel-ից տարբեր էլփոստի հասցեին ուղարկելու համար:

---

Ուղարկեք յուրաքանչյուր թերթ Excel-ից տարբեր էլփոստի հասցեներ VBA կոդով

Հետևյալ VBA կոդը կարող է օգնել ձեզ ուղարկելու յուրաքանչյուր թերթը որպես հավելված տարբեր հասցեատերերի, խնդրում ենք անել այսպես.

1. Մամուլ Alt + F11 ստեղները միաժամանակ բացելու համար Microsoft Visual Basic հավելվածների համար պատուհան.

2, Դրանից հետո կտտացրեք Տեղադրել > Մոդուլներև պատճենեք և տեղադրեք ստորև նշված VBA կոդը պատուհանում:

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

3, Հետո, սեղմեք F5 բանալին գործարկելու համար այս կոդը, և յուրաքանչյուր թերթ ավտոմատ կերպով տեղադրվում է նոր հաղորդագրության պատուհանում՝ որպես հավելված, տես սքրինշոթը՝

4. Վերջապես, դուք պարզապես պետք է սեղմեք ուղարկել կոճակը՝ յուրաքանչյուր նամակ մեկ առ մեկ ուղարկելու համար: