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

 Ինչպե՞ս էլեկտրոնային նամակ ուղարկել Outlook- ի միջոցով Excel- ի ցուցակից մի քանի հասցեատերերի:

Եթե ​​աշխատանքային թերթիկի սյունակում ունեք մի քանի էլփոստի հասցեներ, և այժմ, դուք ցանկանում եք էլ-նամակ ուղարկել ուղղակիորեն Excel- ից ստացողների այս ցուցակին `առանց Outlook- ի բացման: Այս հոդվածում ես կխոսեմ այն ​​մասին, թե ինչպես միաժամանակ նամակ ուղարկել Excel- ից բազմաթիվ ստացողների:

VBA կոդով Excel- ից բազմաթիվ ստացողներին էլ-նամակ ուղարկեք

Ուղարկեք էլեկտրոնային նամակ բազմաթիվ ստացողներին `ներկայիս աշխատանքային գրքով, որպես կցորդ` օգտագործելով VBA կոդ


նետ կապույտ աջ պղպջակ VBA կոդով Excel- ից բազմաթիվ ստացողներին էլ-նամակ ուղարկեք

Միանգամից մի քանի հասցեատերերին հաղորդագրություն ուղարկելու համար կարող եք օգտագործել VBA կոդ, արեք հետևյալը.

1. Անջատեք ALT + F11 բացել ստեղները Microsoft Visual Basic հավելվածների համար պատուհան.

2. Սեղմել Տեղադրել > Մոդուլներ, և տեղադրեք հետևյալ կոդը Մոդուլի պատուհան.

VBA կոդ. Էլ. Նամակ ուղարկել բազմաթիվ հասցեատերերի

Sub sendmultiple()
'updateby Extendoffice
    Dim xOTApp As Object
    Dim xMItem As Object
    Dim xCell As Range
    Dim xRg As Range
    Dim xEmailAddr As String
    Dim xTxt As String
    On Error Resume Next
    xTxt = ActiveWindow.RangeSelection.Address
    Set xRg = Application.InputBox("Please select the addresses list:", "Kutools for Excel", xTxt, , , , , 8)
    If xRg Is Nothing Then Exit Sub
    Set xOTApp = CreateObject("Outlook.Application")
    For Each xCell In xRg
        If xCell.Value Like "*@*" Then
            If xEmailAddr = "" Then
                xEmailAddr = xCell.Value
            Else
                xEmailAddr = xEmailAddr & ";" & xCell.Value
            End If
        End If
    Next
    Set xMItem = xOTApp.CreateItem(0)
    With xMItem
        .To = xEmailAddr
        .Display
    End With
End Sub

3, Եվ հետո սեղմեք F5 Այս կոդը կատարելու համար բանալին կհայտնվի հուշման տուփ ՝ հիշեցնելու համար, որ ընտրեք հասցեների ցուցակը, տես նկարի նկարը.

փաստաթուղթը ուղարկել է մի քանի ստացողի 1

4. Այնուհետեւ կտտացրեք OKև Outlook հաղորդագրություն ցուցադրվում է պատուհանը, դուք կարող եք տեսնել, որ բոլոր ընտրված էլփոստի հասցեները ավելացված են Դեպի դաշտը, ապա կարող եք մուտքագրել թեման և կազմել ձեր հաղորդագրությունը, տեսեք,

փաստաթուղթը ուղարկել է մի քանի ստացողի 2

5, Հաղորդագրությունն ավարտելուց հետո սեղմեք ուղարկել կոճակը, և այս հաղորդագրությունը կուղարկվի այս ստացողներին ձեր աշխատաթերթի ցուցակում:


նետ կապույտ աջ պղպջակ Ուղարկեք էլեկտրոնային նամակ բազմաթիվ ստացողներին `ներկայիս աշխատանքային գրքով, որպես կցորդ` օգտագործելով VBA կոդ

Եթե ​​Ձեզ անհրաժեշտ է հաղորդագրություն ուղարկել բազմաթիվ հասցեատերերին ընթացիկ աշխատանքային գրքով որպես կցորդ, կարող եք կիրառել հետևյալ VBA կոդը:

1, Պահեք պահեք ALT + F11 բացել ստեղները Microsoft Visual Basic հավելվածների համար պատուհան.

2: Սեղմեք Տեղադրել > Մոդուլներ, և տեղադրեք հետևյալ կոդը Մոդուլի պատուհան.

VBA կոդ. Ուղարկեք էլեկտրոնային փոստով բազմաթիվ ստացողների ընթացիկ աշխատանքային գրքույկով ՝ որպես հավելված

Sub EmailAttachmentRecipients()
'updateby Extendoffice
    Dim xOutlook As Object
    Dim xMailItem As Object
    Dim xRg As Range
    Dim xCell As Range
    Dim xEmailAddr As String
    Dim xTxt As String
    On Error Resume Next
    xTxt = ActiveWindow.RangeSelection.Address
    Set xRg = Application.InputBox("Please select the arresses list:", "Kutools for Excel", xTxt, , , , , 8)
    If xRg Is Nothing Then Exit Sub
    Set xOutlook = CreateObject("Outlook.Application")
    Set xMailItem = xOutlook.CreateItem(0)
    For Each xCell In xRg
        If xCell.Value Like "*@*" Then
            If xEmailAddr = "" Then
                xEmailAddr = xCell.Value
            Else
                xEmailAddr = xEmailAddr & ";" & xCell.Value
            End If
        End If
    Next
    With xMailItem
        .To = xEmailAddr
        .CC = ""
        .Subject = ""
        .Body = ""
        .Attachments.Add ActiveWorkbook.FullName
        .Display
    End With
    Set xOutlook = Nothing
    Set xMailItem = Nothing
End Sub

3, Կոդը տեղադրելուց հետո սեղմեք F5 այս կոդն աշխատեցնելու համար ստեղն է, և դուրս է գալիս հուշման տուփ, որը հիշեցնում է ձեզ ՝ ընտրելով այն հասցեները, որոնց ցանկանում եք ուղարկել հաղորդագրություն, տես նկարի նկարը.

փաստաթուղթը ուղարկել է մի քանի ստացողի 3

4. Այնուհետեւ կտտացրեք OK կոճակը և Outlook- ը հաղորդագրություն ցուցադրվում է պատուհանը, բոլոր էլ. փոստի հասցեները ավելացվել են Դեպի դաշտը, և ձեր ընթացիկ աշխատանքային գրքույկը տեղադրվել է նաև որպես հավելված, և այնուհետև կարող եք մուտքագրել թեման և կազմել ձեր հաղորդագրությունը, տես նկարի նկարը.

փաստաթուղթը ուղարկել է մի քանի ստացողի 4

5. Այնուհետեւ կտտացրեք ուղարկել կոճակը `այս հաղորդագրությունն ընթացիկ աշխատանքային գրքով որպես կցորդ ստացողների ցուցակին ուղարկելու համար:


Անհատականացված էլ-նամակներ ուղարկեք տարբեր կցորդներով բազմաթիվ ստացողների.

հետ Excel- ի համար նախատեսված գործիքներ's Ուղարկել նամակներ առանձնահատկությունը, դուք կարող եք արագ ուղարկել Excel- ից տարբեր կցորդներով բազմաթիվ հասցեատերերի անհատականացված էլ-նամակներ Outlook- ի միջոցով, որքան ձեզ հարկավոր է: Միևնույն ժամանակ, Դուք կարող եք CC կամ Bcc հաղորդագրությունները ուղարկել նաև որոշակի անձի: Կտտացրեք Excel- ի համար Kutools ներբեռնելու համար:

doc ուղարկել անհատականացված էլ. նամակներ 18 1


Առնչվող հոդված:

Ինչպե՞ս անհատականացված զանգվածային էլ-նամակներ Excel- ից ցուցակ ուղարկել Outlook- ի միջոցով:


Գրասենյակի արտադրողականության լավագույն գործիքները

Excel-ի համար Kutools-ը լուծում է ձեր խնդիրների մեծ մասը և բարձրացնում ձեր արտադրողականությունը 80%-ով

  • Վերաօգտագործել: Արագ տեղադրեք բարդ բանաձևեր, գծապատկերներ և այն ամենը, ինչ դուք նախկինում օգտագործել եք. Ryածկագրել բջիջները գաղտնաբառով; Ստեղծեք փոստային ցուցակ և նամակներ ուղարկել ...
  • Super Formula Bar (հեշտությամբ խմբագրեք տեքստի և բանաձևի բազմաթիվ տողեր); Ընթերցանության դասավորությունը (հեշտությամբ կարդալ և խմբագրել մեծ թվով բջիջներ); Տեղադրել ֆիլտրացված տիրույթում...
  • Միաձուլել բջիջները / տողերը / սյունակները առանց տվյալների կորստի. Պառակտված բջիջների պարունակությունը; Միավորել կրկնօրինակ տողերը / սյունակները... Կանխել կրկնօրինակ բջիջները; Համեմատեք միջակայքերը...
  • Ընտրեք Կրկնօրինակ կամ Եզակի Շարքեր; Ընտրեք դատարկ շարքեր (բոլոր բջիջները դատարկ են); Super Find և Fuzzy Find շատ աշխատանքային գրքույկներում; Պատահական ընտրություն ...
  • Actշգրիտ պատճեն Բազմաթիվ բջիջներ ՝ առանց բանաձևի հղումը փոխելու; Ավտոմատ ստեղծեք հղումներ դեպի մի քանի թերթեր; Տեղադրեք փամփուշտներ, Տուփեր և ավելին ...
  • Քաղվածք տեքստ, Տեքստ ավելացնել, հեռացնել ըստ դիրքի, Հեռացնել տարածությունը; Ստեղծել և տպել էջային ենթագոտիներ; Փոխարկել բջիջների բովանդակության և մեկնաբանությունների միջև...
  • Սուպեր զտիչ (պահպանել և կիրառել ֆիլտրի սխեմաները այլ թերթերի վրա); Ընդլայնված տեսակավորում ըստ ամիս / շաբաթ / օր, հաճախականություն և ավելին; Հատուկ զտիչ համարձակ, շեղատառով ...
  • Միավորել աշխատանքային տետրերը և աշխատանքային թերթերը; Միավորել աղյուսակները ՝ հիմնված հիմնական սյունակների վրա; Տվյալները բաժանեք մի քանի թերթերի; Խմբաքանակի փոխակերպում xls, xlsx և PDF...
  • Ավելի քան 300 հզոր հատկություններ. Աջակցում է Office / Excel 2007-2021 և 365: Աջակցում է բոլոր լեզուներին: Հեշտ տեղակայում ձեր ձեռնարկությունում կամ կազմակերպությունում: Ամբողջական հնարավորություններ 30-օրյա անվճար փորձարկում: 60-օրյա գումարի վերադարձի երաշխիք:
kte էջանիշը 201905

Office Tab- ը Tabbed ինտերֆեյսը բերում է Office, և ձեր աշխատանքը շատ ավելի դյուրին դարձրեք

  • Միացնել ներդիրներով խմբագրումը և ընթերցումը Word, Excel, PowerPoint- ով, Հրատարակիչ, Access, Visio և Project:
  • Բացեք և ստեղծեք բազմաթիվ փաստաթղթեր նույն պատուհանի նոր ներդիրներում, այլ ոչ թե նոր պատուհաններում:
  • Բարձրացնում է ձեր արտադրողականությունը 50%-ով և նվազեցնում մկնիկի հարյուրավոր սեղմումները ձեզ համար ամեն օր:
officetab ներքևում
Տեսակավորել մեկնաբանությունները ըստ
մեկնաբանություններ (20)
Դեռևս գնահատականներ չկան: Եղիր առաջինը, ով կգնահատի:
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
Սա հիանալի է, հենց այն, ինչ ես ուզում եմ: Կա՞ արդյոք որևէ հատկություն ավելացնելու համար, որտեղ դուք կարող եք հաղորդագրություն ավելացնել թեմայի տողին՝ օգտագործելով կոդը... Ես ոչինչ չեմ ուզում հաղորդագրության տուփում:
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
Բարև, VBA կոդը լավ է աշխատում ինձ համար, շնորհակալություն: Կա՞ որևէ կերպ, որով ես կարող եմ բջիջ ստեղծել մի տեսակ կոճակով, որն առաջացնում է «ընտրել փոստային ցուցակը»: Ջեյք
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
Ողջույն, շնորհակալություն կոդը համար: Արդյո՞ք կարող եմ ստեղծել հրամանի կոճակ excel-ի վրա, այնուհետև սեղմելով այդ կոճակի վրա, նույն Excel թերթիկը կարող է ուղարկվել բազմաթիվ հասցեատերերի՝ որպես հավելված:
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
Ինչպե՞ս կարող եմ դա անել՝ օգտագործելով BCC գիծը:
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
Բարև, Ռոբերտ,
Կոդը գործարկելուց հետո կբացվի նոր հաղորդագրության պատուհանը, պարզապես անհրաժեշտ է Option ներդիրի տակ տեղադրել BCC տողը, տես հետևյալ սքրինշոթը.


Հուսով եմ, որ դա կարող է օգնել ձեզ, շնորհակալություն:
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
Սա օգտագործելու որևէ միջոց կա՞ ընդհանուր էլփոստից ուղարկելու համար: Կարծես չեմ կարող տեղադրել .SendOnBehalfOf դաշտ:
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
Ողջու՜յն ! Ամեն ամիս ես պետք է նույն էլփոստը ուղարկեմ տարբեր մատակարարների համար, բայց դրանք չպետք է լինեն նույն էլ. ?
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
Բարև, Վինիսիուս,
Միևնույն նամակը բազմաթիվ հասցեատերերի առանձին ուղարկելու համար կարող է ձեզ օգնել հետևյալ հոդվածը, խնդրում ենք դիտել այն:
https://www.extendoffice.com/documents/excel/3560-excel-send-personalized-email.html
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
Առավոտ,


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

Շնորհակալություն

Steve
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
Ես ունեմ այս կոդը, իմ խնդիրն այն է, որ այն ստեղծում է մեկ էլ.

Sub EnviarCorreo ()
Dim OutApp-ը որպես օբյեկտ
Մթնեցնել OutMail որպես օբյեկտ
Dim lLast Row As Long
Dim lRow As Long
Dim sSendTo As String
Dim sSendCC որպես տող
Dim sSendBCC որպես տող
Dim sSubject As String
Dim sTemp As String

Set OutApp = CreateObject («Outlook.Application»)
OutApp.Session.Logon

Փոխեք հետևյալը ըստ անհրաժեշտության
sSendTo = ""
sSendCC = ""
sSendBCC = ""
sSubject = «Վերջնական ժամկետը հասել է»

Սահմանել OutMail = OutApp.CreateItem(0)

lLastRow = Բջիջներ (Rows.Count, 3).End(xlUp).Տող
lRow = 3 To lLastRow-ի համար
If Cells(lRow, 9) <> «S» Ապա
If Cells(lTow, 2) <= Date then

Ս.թ. սխալի Ռեզյումե Next
OutMail-ի հետ
.To = sSendTo
Եթե ​​sSendCC > "" Ապա .CC = sSendCC
Եթե ​​sSendBCC > "" Ապա .BCC = sSendBCC
.Subject = sSubject

sTemp = «Բարև ձեզ»: & vbCrLf & vbCrLf
sTemp = sTemp & «Վճարման ժամկետը հասել է»
sTemp = sTemp & «այս նախագծի համար.» & vbCrLf & vbCrLf


«ՍԱ այն է, ինչ ես ուզում եմ կրկնել էլփոստի հասցեում
Ենթադրում է, որ նախագծի անվանումը B սյունակում է
sTemp = sTemp & «ID:»
sTemp = sTemp & " " & Բջիջներ (lՏող, 1)
sTemp = sTemp & «Նկարագրություն.
sTemp = sTemp & " " & Բջիջներ (lՏող, 5)
sTemp = sTemp & «Խնդրում ենք վերցնել համապատասխանը»
sTemp = sTemp & «գործողություններ»: & vbCrLf & vbCrLf
sTemp = sTemp & «Շնորհակալություն»: & vbCrLf
― ՄԻՆՉԵՎ ԱՅՍՏԵՂ



.Մարմին = sTemp
Փոխեք հետևյալը .Ուղարկեք, եթե ցանկանում եք
Ուղարկեք հաղորդագրությունը առանց նախապես վերանայելու
.Dուցադրել
Վերջ
Սահմանել OutMail = Ոչինչ

Բջիջներ (lՏող, 9) = «S»
Cells(lRow, 10) = "E-mail ուղարկվել է. " & Now()
Վերջ: Եթե
Վերջ: Եթե
Հաջորդ տող
Սահմանել OutApp = Ոչինչ
Վերջ Sub
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
Հնարավո՞ր է արդյոք ցուցակից CC-ների ընտրության կոդը կավատել TO-ն ընտրելուց հետո: Գոյություն ունեցող ծածկագրով հնարավոր չէ ընտրել որևէ CC նույն կերպ, ինչպես TO-ները (հիմնական հասցեները): 
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
Բարև Յուգեն, ուրախ եմ օգնել: Հնարավոր է կավատել ցուցակից CC-ների ընտրության ծածկագիրը ՏՏ-ն ընտրելուց հետո: Եվ կոդը հիմնականում նույնն է TOs VBA կոդի հետ: Միայն մեկ փոփոխություն պետք է արվի. Պարզապես փոխեք «.To = xEmailAddr»-ը «.Cc = xEmailAddr»-ի: Խնդրում ենք տեսնել սքրինշոթը: Եվ դուք կարող եք ընտրել CC-ները և TO-ները ցուցակից միաժամանակ: Պարզապես դարձրեք «.To = xEmailAddr» և «.Cc = xEmailAddr» բոլորը ներառված VBA կոդում: Խնդրում ենք տեղադրել հետևյալ կոդը մոդուլի պատուհանում:
Sub sendmultiple ()
«թարմացնելով Extendoffice
Խոնավեցրեք xOTApp-ը որպես օբյեկտ
Dim xMItem-ը որպես օբյեկտ
Dim xCell-ը որպես տիրույթ
Dim xRg որպես տիրույթ
Dim xEmailAddr As String
Dim xTxt որպես տող
Ս.թ. սխալի Ռեզյումե Next
xTxt = ActiveWindow.RangeSelection.Address
Սահմանել xRg = Application.InputBox («Խնդրում ենք ընտրել հասցեների ցանկը.», «Kutools for Excel», xTxt, , , , , 8)
Եթե ​​xRg-ը ոչինչ է, ապա դուրս եկեք Sub
Սահմանել xOTApp = CreateObject («Outlook.Application»)
Յուրաքանչյուր xCell-ի համար xRg-ում
If xCell.Value Like «*@*» Ապա
Եթե ​​xEmailAddr = "" Ապա
xEmailAddr = xCell.Value
Ուրիշ
xEmailAddr = xEmailAddr & ";" & xCell.Value
Վերջ: Եթե
Վերջ: Եթե
հաջորդ
Սահմանել xMItem = xOTApp.CreateItem (0)
xMItem-ի հետ
.To = xEmailAddr
.Cc = xEmailAddr
.Dուցադրել
Վերջ
Վերջ Sub

Հուսով եմ, որ դա կարող է լուծել ձեր խնդիրը: Բարի օր: Հարգանքներով, Մենդի
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
Ես փորձում եմ ստանալ Excel-ը մի քանի հասցեատերերի նամակ ուղարկելու համար և կարող եմ ստանալ այն ամենը, ինչ ինձ անհրաժեշտ է, բայց նա հրաժարվում է էլփոստի հասցեն տեղադրել TO վանդակում: Ահա այն կոդը, որի հետ ես աշխատել եմ: Որևէ մեկը կարո՞ղ է օգնել ինձ հասկանալ, թե ինչ եմ սխալ անում: Շատ շնորհակալություն!

Ենթամակրո1()
Dim rngCell-ը որպես տիրույթ
Dim rngMyDataSet As Range
Dim Rng որպես միջակայք
Dim OutApp-ը որպես օբյեկտ
Մթնեցնել OutMail որպես օբյեկտ
Փայլեցրեք էլփոստի թեման որպես տող
Dim EmailSendTo As String
Dim MailBody As String
Էլփոստի ստացողի խամրածությունը որպես տիրույթ
Dim Signature As String
Դիմում. ScreenUpdating = Սուտ է
ActiveSheet- ով
Եթե ​​.FilterMode Ապա .ShowAllData
Սահմանել Rng = .Range("AK6", .Cells(.Rows.Count, 1).End(xlUp))
Վերջ
Յուրաքանչյուր rngCell-ի համար Rng-ում
Եթե ​​rngCell.Offset(0, 6) > 0 Ապա

ElseIf rngCell.Offset(0, 5) > Evaluate("Today() +7") And _
rngCell.Offset(0, 5).Value <= Evaluate("Today() +30") Հետո
rngCell.Offset(0, 6) Value = Ամսաթիվ

Set OutApp = CreateObject («Outlook.Application»)
Սահմանել OutMail = OutApp.CreateItem(0)

strbody = «Իմ գրառումների համաձայն՝ ձեր պայմանագիրը « & Range («A6»): Արժեք & «-ը ենթակա է վերանայման « & rngCell.Offset(0, 5): Value & vbNewLine & _
«Խնդրում ենք վերանայել այս պայմանագիրը մինչև համապատասխան ամսաթիվը և ինձ էլեկտրոնային նամակ ուղարկել այս պայմանագրի մեջ ձեր կատարած ցանկացած փոփոխության մասին: Եթե այն երկարաձգվի, խնդրում ենք լրացնել պայմանագրի ծածկաթերթը, որը կարելի է գտնել «Բոլորը» թղթապանակում և ուղարկել ինձ նոր բնօրինակ պայմանագիրը: «
EmailSendTo = rngCell.Offset(0, 0). Արժեք
EmailSubject = Sheets("sheet1").Range("A6").Value
Ստորագրություն = "C:\Documents and Settings\" & Environ("rmm") & _
«\Application Data\Microsoft\Signatures\rm.htm»
Ս.թ. սխալի Ռեզյումե Next
OutMail-ի հետ
Դեպի = EmailSendTo
.CC = "hhh@gmail.com"
.BCC = ""
.Subject = EmailSubject
.Մարմին = strbody
.Dուցադրել
Send_Value = Mail_Recipient.Offset(i - 1).Value
Վերջ
Սխալի դեպքում GoTo 0
Սահմանել OutMail = Ոչինչ
Սահմանել OutApp = Ոչինչ

Վերջ: Եթե

Հաջորդ rngCell
Դիմում. ScreenUpdating = ueիշտ է
Վերջ Sub
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
Բարև Դիանա,
Միգուցե դուք կարող եք կիրառել հետևյալ կոդը.

Sub Macro1()
Dim rngCell As Range
Dim Rng As Range
Dim OutApp As Object
Dim OutMail As Object
Dim EmailSubject As String
Dim EmailSendTo As String
Dim MailBody As String
Dim Signature As String
Application.ScreenUpdating = False
On Error Resume Next
With ActiveSheet
  If .FilterMode Then .ShowAllData
  Set Rng = .Range("AK6", .Cells(.Rows.Count, 1).End(xlUp))
End With
Set OutApp = CreateObject("Outlook.Application")
For Each rngCell In Rng
  If rngCell.Offset(0, 6) > 0 Then
    If rngCell.Offset(0, 5).Value > Evaluate("Today() +7") And _
       rngCell.Offset(0, 5).Value <= Evaluate("Today() +30") Then
      rngCell.Offset(0, 6).Value = Date
    End If
    Set OutMail = OutApp.CreateItem(0)
    MailBody = "According to my records, your contract " & Range("A6").Value & " is due for review on " & rngCell.Offset(0, 6).Value & vbNewLine & _
               "Please review this contract prior to the pertinent date and email me with any changes you make to this contract. If it is renewed, " & _
               "please fill out the Contract Cover Sheet which can be found in the Everyone folder and send me the new original contract."
    
    EmailSendTo = rngCell.Offset(2, 6).Value   'Please specify the row and column number of the addresses in the filtered data range,please change the number 2 and 6 to your need
    EmailSubject = Sheets("sheet1").Range("A6").Value
    Signature = "C:\Documents and Settings\" & Environ("rmm") & _
                "\Application Data\Microsoft\Signatures\rm.htm"
    With OutMail
      .To = EmailSendTo
      .CC = "hhh@gmail.com"
      .BCC = ""
      .Subject = EmailSubject
      .Body = MailBody
      .Recipients.ResolveAll
      .Display
    End With
  End If
Next rngCell
Set OutMail = Nothing
Set OutApp = Nothing
Application.ScreenUpdating = True
End Sub



EmailSendTo = rngCell.Offset(2, 6). Արժեք, դուք պետք է փոխեք 2-րդ և 6-րդ համարները տողի և սյունակի համարի՝ ելնելով ձեր տվյալների տիրույթից, այս տիրույթը պարունակում է էլփոստի հասցեները, որոնց ցանկանում եք ուղարկել:

Խնդրում եմ փորձեք, հուսով եմ, որ դա կարող է օգնել ձեզ:
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
Շնորհակալություն, բայց, ցավոք, չստացվեց: Ես դեռ նույն արդյունքներն եմ ստանում:
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
Բարև, Դիանա,
Այս դեպքում խնդրում ենք տրամադրել աշխատաթերթի տվյալների սքրինշոթ կամ կցված ֆայլ, որպեսզի կարողանանք որոշել, թե որտեղ է խնդիրը:
Կամ կարող եք ավելի պարզ և մանրամասն նկարագրել ձեր խնդիրը:
Thank you!
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
Ստորև ներկայացված է ընթացիկ կոդը, որը ես օգտագործում եմ, բայց այն չի տեղադրի յուրաքանչյուր էլփոստի հասցեն TO վանդակում, միայն առաջին էլփոստի հասցեն բոլորի մեջ: Նաև նույն բանն է անում SUBJECT-ի և էլփոստի հաղորդագրության մեջ, այն պարզապես օգտագործում է նույն բանը նորից ու նորից: Ես վստահ չեմ, թե ինչպես կցել աղյուսակը այս էլ.

Ենթամակրո1()
Dim rngCell-ը որպես տիրույթ
Dim rngMyDataSet As Range
Dim Rng որպես միջակայք
Dim OutApp-ը որպես օբյեկտ
Մթնեցնել OutMail որպես օբյեկտ
Փայլեցրեք էլփոստի թեման որպես տող
Dim EmailSendTo As String
Dim MailBody As Range
Էլփոստի ստացողի խամրածությունը որպես տիրույթ
Dim Signature As String
Դիմում. ScreenUpdating = Սուտ է
ActiveSheet- ով
Եթե ​​.FilterMode Ապա .ShowAllData
Սահմանել Rng = .Range("AJ6", .Cells(.Rows.Count, 1).End(xlUp))
Վերջ
Յուրաքանչյուր rngCell-ի համար Rng-ում
Եթե ​​rngCell.Offset(0, 6) > 0 Ապա

ElseIf rngCell.Offset(0, 5) > Evaluate("Today() +7") And _
rngCell.Offset(0, 5).Value <= Evaluate("Today() +120") Հետո
rngCell.Offset(0, 6) Value = Ամսաթիվ

Set OutApp = CreateObject («Outlook.Application»)
Սահմանել OutMail = OutApp.CreateItem(0)

strbody = «Իմ գրառումների համաձայն՝ ձեր « & Range («A6»). Արժեք & « պայմանագիրը ենթակա է վերանայման» & rngCell.Offset(0, 5). Value & _
Կարևոր է, որ դուք շուտափույթ վերանայեք այս պայմանագիրը և ինձ էլփոստով ուղարկեք կատարված փոփոխությունները: Եթե այն երկարաձգվի, խնդրում ենք լրացնել Պայմանագրի ծածկաթերթը, որը կարելի է գտնել «Բոլորը» թղթապանակում և ուղարկել ինձ ծածկաթերթիկը նոր սկզբնական պայմանագրի հետ միասին: »:
EmailSendTo = Թերթիկներ ("sheet1"). Range ("AJ6"). Արժեք
EmailSubject = Sheets("sheet1").Range("A6").Value
Ստորագրություն = "C:\Documents and Settings\" & Environ("rmm") & _
«\Application Data\Microsoft\Signatures\rm.htm»
Ս.թ. սխալի Ռեզյումե Next
OutMail-ի հետ
Դեպի = EmailSendTo
.CC = "hhh@gmail.com"
.BCC = ""
.Subject = EmailSubject
.Մարմին = strbody
.Dուցադրել
Send_Value = Mail_Recipient.Offset(i - 1).Value
Վերջ
Սխալի դեպքում GoTo 0
Սահմանել OutMail = Ոչինչ
Սահմանել OutApp = Ոչինչ

Վերջ: Եթե

Հաջորդ rngCell
Դիմում. ScreenUpdating = ueիշտ է
Վերջ Sub
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
Բարեւ,
Դուք կարող եք տեղադրել ձեր աշխատանքային գիրքը որպես հավելված այստեղ, խնդրում ենք տեսնել ստորև ներկայացված սքրինշոթը.
https://www.extendoffice.com/images/stories/comments/comment-skyyang/doc-attachment-1.png
Thank you!
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
Իմ ծայրին «Վերբեռնման հավելված» վանդակ չկա:
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
Բարև Դիանա,
Եթե ​​չկա «Վերբեռնել առդիր» վանդակը, ապա նախ պետք է գրանցվել, ապա կհայտնվի «Վերբեռնել հավելված» տարբերակը։
Գրանցվելու համար խնդրում ենք գնալ հոդվածի վերևում և սեղմել Գրանցվել սկսելու կոճակը:
https://www.extendoffice.com/images/stories/comments/comment-skyyang/doc-register.png
Ներողություն եմ խնդրում անհարմարության համար։
Առայժմ ոչ մի մեկնաբանություն չկա
Թողեք ձեր մեկնաբանությունները
Հրապարակում որպես հյուր
×
Գնահատեք այս գրառումը.
0   Անձնավորություններ
Առաջարկվող վայրեր

Հետեւեք մեզ

Հեղինակային իրավունքի © 2009 - www.extendoffice.com. | Բոլոր իրավունքները պաշտպանված են. Powered by ExtendOffice. | | Կայքի քարտեզ
Microsoft- ը և Office- ի պատկերանշանը հանդիսանում են Microsoft Corporation- ի ապրանքային նշաններ կամ գրանցված ապրանքային նշաններ ԱՄՆ-ում և (կամ) այլ երկրներում:
Պաշտպանված է Sectigo SSL- ի կողմից