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

Ինչպե՞ս արտահանել էլփոստերը բազմաթիվ պանակներից / ենթապանակներից ՝ Outlook- ում գերազանցելու համար:

Outlook- ում Ներմուծման և արտահանման մոգով պանակ արտահանելիս այն չի աջակցում Ներառեք ենթապանակներ տարբերակը, եթե դուք թղթապանակը արտահանեք CSV ֆայլ: Այնուամենայնիվ, բավականին ժամանակատար և հոգնեցուցիչ կլինի յուրաքանչյուր թղթապանակ արտահանել CSV ֆայլ, ապա այն ձեռքով վերափոխել Excel աշխատանքային գրքի: Այստեղ այս հոդվածը կներկայացնի VBA ՝ հեշտությամբ բազմաթիվ աշխատանքային պանակներ և ենթապանակներ արտահանելու համար Excel- ի աշխատանքային գրքեր:

VBA- ի միջոցով բազմաթիվ թղթապանակներից / ենթապանակներից բազմաթիվ էլ-նամակներ արտահանեք Excel

Office Tab - Միացնել ներդիրներով խմբագրումն ու զննարկումը գրասենյակում, և աշխատանքը շատ ավելի դյուրին դարձրեք ...
Kutools for Outlook - 100 հզոր առաջադեմ առանձնահատկություններ է բերում Microsoft Outlook- ին
  • Auto CC / BCC կանոններով `էլ. նամակ ուղարկելիս; Ավտոմեքենաների փոխանցում Բազմաթիվ էլ-նամակներ կանոններով; Ավտոմատ պատասխան առանց փոխանակման սերվերի և ավելի ավտոմատ հատկությունների ...
  • Նախազգուշացում BCC- ի համար - ցույց տալ հաղորդագրությունը, երբ փորձում եք պատասխանել բոլորին, եթե ձեր փոստի հասցեն գտնվում է BCC ցուցակում. Հիշեցրեք հավելվածները բաց թողնելիսև ավելին հիշեցնում են հատկությունները ...
  • Պատասխանեք (բոլորը) բոլոր կցորդներով փոստի խոսակցությունում; Միանգամից պատասխանեք շատ նամակների. Ավտոմատ ավելացնել ողջույնները երբ պատասխանել; Ավտոմատ ավելացրեք ամսաթիվը և ժամանակը թեմայի մեջ ...
  • Կցման գործիքներԱվտոմատ անջատել, սեղմել բոլորը, վերանվանել բոլորը, ինքնաբերաբար պահպանել բոլորը ... Արագ հաշվետվություն, Հաշվել ընտրված նամակները, Հեռացնել կրկնօրինակ նամակները և կոնտակտները ...
  • Ավելի քան 100 առաջադեմ գործառույթներ կանեն լուծեք ձեր խնդիրների մեծ մասը Outlook 2021 - 2010 կամ Office 365-ում: Ամբողջական հնարավորություններ 60-օրյա անվճար փորձարկում:

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

Խնդրում ենք հետևել ստորև ներկայացված քայլերին `Outlook- ում VBA- ով աշխատող Excel գրքերից բազմաթիվ թղթապանակներից կամ ենթապանակներից էլփոստեր արտահանելու համար:

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

2: սեղմեք Տեղադրել > Մոդուլներ, ապա VBA կոդի տակ տեղադրեք նոր Մոդուլի պատուհանում:

VBA. Բազմաթիվ պանակներից և ենթապանակներից էլփոստով արտահանեք Excel

Const MACRO_NAME = "Export Outlook Folders to Excel"

Sub ExportMain()
ExportToExcel "destination_folder_path\A.xlsx", "your_email_accouny\folder\subfolder_1"
ExportToExcel "destination_folder_path\B.xlsx", "your_email_accouny\folder\subfolder_2"
MsgBox "Process complete.", vbInformation + vbOKOnly, MACRO_NAME
End Sub
Sub ExportToExcel(strFilename As String, strFolderPath As String)
Dim      olkMsg As Object
Dim olkFld As Object
Dim excApp As Object
Dim excWkb As Object
Dim excWks As Object
Dim intRow As Integer
Dim intVersion As Integer

If strFilename <> "" Then
If strFolderPath <> "" Then
Set olkFld = OpenOutlookFolder(strFolderPath)
If TypeName(olkFld) <> "Nothing" Then
intVersion = GetOutlookVersion()
Set excApp = CreateObject("Excel.Application")
Set excWkb = excApp.Workbooks.Add()
Set excWks = excWkb.ActiveSheet
'Write Excel Column Headers
With excWks
.Cells(1, 1) = "Subject"
.Cells(1, 2) = "Received"
.Cells(1, 3) = "Sender"
End With
intRow = 2
For Each olkMsg In olkFld.Items
'Only export messages, not receipts or appointment requests, etc.
If olkMsg.Class = olMail Then
'Add a row for each field in the message you want to export
excWks.Cells(intRow, 1) = olkMsg.Subject
excWks.Cells(intRow, 2) = olkMsg.ReceivedTime
excWks.Cells(intRow, 3) = GetSMTPAddress(olkMsg, intVersion)
intRow = intRow + 1
End If
Next
Set olkMsg = Nothing
excWkb.SaveAs strFilename
excWkb.Close
Else
MsgBox "The folder '" & strFolderPath & "' does not exist in Outlook.", vbCritical + vbOKOnly, MACRO_NAME
End If
Else
MsgBox "The folder path was empty.", vbCritical + vbOKOnly, MACRO_NAME
End If
Else
MsgBox "The filename was empty.", vbCritical + vbOKOnly, MACRO_NAME
End If

Set olkMsg = Nothing
Set olkFld = Nothing
Set excWks = Nothing
Set excWkb = Nothing
Set excApp = Nothing
End Sub

Public Function OpenOutlookFolder(strFolderPath As String) As Outlook.MAPIFolder
Dim arrFolders As Variant
Dim varFolder As Variant
Dim bolBeyondRoot As Boolean

On Error Resume Next
If strFolderPath = "" Then
Set OpenOutlookFolder = Nothing
Else
Do While Left(strFolderPath, 1) = "\"
strFolderPath = Right(strFolderPath, Len(strFolderPath) - 1)
Loop
arrFolders = Split(strFolderPath, "\")
For Each varFolder In arrFolders
Select Case bolBeyondRoot
Case False
Set OpenOutlookFolder = Outlook.Session.Folders(varFolder)
bolBeyondRoot = True
Case True
Set OpenOutlookFolder = OpenOutlookFolder.Folders(varFolder)
End Select
If Err.Number <> 0 Then
Set OpenOutlookFolder = Nothing
Exit For
End If
Next
End If
On Error GoTo 0
End Function

Function GetSMTPAddress(Item As Outlook.MailItem, intOutlookVersion As Integer) As String
Dim olkSnd As Outlook.AddressEntry
Dim olkEnt As Object

On Error Resume Next
Select Case intOutlookVersion
Case Is < 14
If Item.SenderEmailType = "EX" Then
GetSMTPAddress = SMTPEX(Item)
Else
GetSMTPAddress = Item.SenderEmailAddress
End If
Case Else
Set olkSnd = Item.Sender
If olkSnd.AddressEntryUserType = olExchangeUserAddressEntry Then
Set olkEnt = olkSnd.GetExchangeUser
GetSMTPAddress = olkEnt.PrimarySmtpAddress
Else
GetSMTPAddress = Item.SenderEmailAddress
End If
End Select
On Error GoTo 0
Set olkPrp = Nothing
Set olkSnd = Nothing
Set olkEnt = Nothing
End Function

Function GetOutlookVersion() As Integer
Dim arrVer As Variant
arrVer = Split(Outlook.Version, ".")
GetOutlookVersion = arrVer(0)
End Function

Function SMTPEX(olkMsg As Outlook.MailItem) As String
Dim olkPA As Outlook.propertyAccessor
On Error Resume Next
Set olkPA = olkMsg.propertyAccessor
SMTPEX = olkPA.GetProperty("http://schemas.microsoft.com/mapi/proptag/0x5D01001E")
On Error GoTo 0
Set olkPA = Nothing
End Function

3. Խնդրում ենք հարմարեցնել վերոհիշյալ VBA կոդը, որքան անհրաժեշտ է:

(1) Փոխարինել նպատակակետի թղթապանակի_ուղին վերը նշված կոդի մեջ `նպատակակետի պանակի պանակի ուղիով, դուք կփրկեք արտահանված աշխատանքային գրքերը, օրինակ` C: \ Users \ DT168 \ Documents \ TEST.
(2) Վերոհիշյալ կոդում փոխարինեք ձեր_էլեկտրոնային_ապակ \ պանակը \ ենթապանակը_1 և Ձեր_հաղորդիչը_փոստը \ ենթապանակը_2 ձեր ենթապանակների թղթապանակի ուղիներով, ինչպիսիք են. Kelly @extendoffice.com \ Մուտքի արկղ \ A և Kelly @extendoffice.com \ Մուտքի արկղ \ B

4. Սեղմեք F5 ստեղնը կամ սեղմել Վազում այս VBA- ն գործարկելու կոճակը: Եվ այնուհետև կտտացրեք OK կոճակը դուրս գալու համար Արտահանել Outlook Թղթապանակներ դեպի Excel երկխոսության տուփ: Տեսեք,

Եվ հիմա VBA կոդի վերը նշված բոլոր նշված ենթապանակներից կամ թղթապանակներից էլփոստերը արտահանվում և պահվում են Excel- ի աշխատանքային գրքերում:


նետ կապույտ աջ պղպջակԱռնչվող հոդվածներ


Kutools Outlook- ի համար. 100 առաջադեմ առանձնահատկություններ է բերում Outlook- ին և շատ ավելի հեշտացնում աշխատանքը:

  • Auto CC / BCC կանոններով `էլ. նամակ ուղարկելիս; Ավտոմեքենաների փոխանցում Բազմաթիվ նամակներ ըստ սովորույթի; Ավտոմատ պատասխան առանց փոխանակման սերվերի և ավելի ավտոմատ հատկությունների ...
  • Նախազգուշացում BCC- ի համար - ցույց տալ հաղորդագրությունը, երբ փորձում ես պատասխանել բոլորին եթե ձեր փոստի հասցեն գտնվում է BCC ցուցակում; Հիշեցրեք հավելվածները բաց թողնելիսև ավելին հիշեցնում են հատկությունները ...
  • Պատասխանեք (բոլորը) փոստի խոսակցության բոլոր կցորդներով; Պատասխանեք շատ նամակների վայրկյանների ընթացքում; Ավտոմատ ավելացնել ողջույնները երբ պատասխանել; Ավելացնել ամսաթիվը վերնագրում ...
  • Կցման գործիքներ. Կառավարեք բոլոր կցորդները բոլոր փոստերում, Ավտոմատ անջատում, Սեղմել բոլորը, Վերանվանել բոլորը, պահպանել բոլորը ... Արագ զեկույց, Հաշվեք ընտրված նամակները...
  • Հզոր անպիտան նամակներ ըստ սովորույթի; Հեռացրեք կրկնօրինակ նամակները և կոնտակտները... Հնարավորություն տվեք Outlook- ում ավելի խելացի, արագ և լավ կատարել:
shot kutools Outlook kutools էջանիշ 1180x121
shot kutools Outlook kutools գումարած ներդիր 1180x121
 
Տեսակավորել մեկնաբանությունները ըստ
մեկնաբանություններ (10)
Դեռևս գնահատականներ չկան: Եղիր առաջինը, ով կգնահատի:
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
Ինչպե՞ս կարող եմ սա ավտոմատ կերպով կրկնել ենթաթղթապանակներում:
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
բարև սիրելիս, ամեն ինչ լավ է աշխատում, շատ շնորհակալություն, բայց մարմինը չի արտահանվում, ինչպես կարող եմ արտահանել էլփոստի մարմինը, excel ֆայլը հենց նոր է (Subject, Received, and Sender), եթե կարող ես թարմացնել ինձ դրանով, մեծ խնդիր կլուծվի իմ բիզնեսում կրկին շատ շնորհակալություն
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
Բարև Մոնթասեր,
VBA սկրիպտն աշխատում է Outlook-ի Արտահանման գործառույթի հիման վրա, որը չի աջակցում հաղորդագրության բովանդակության արտահանում, երբ էլփոստի թղթապանակից էլ-նամակներ զանգվածաբար արտահանվում են: Հետևաբար, այս VBA սցենարը նույնպես չի կարող արտահանել հաղորդագրությունների բովանդակությունը:
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
սա հիանալի է աշխատում, բայց կա՞ միջոց ավելացնելու տեղեկությունները ոչ միայն վերը նշված 4 դաշտերի, այլ այն ամենի համար, ինչ տալիս է Outlook-ի արտահանումը PST: Թեմայի մարմին From՝ (անուն) From՝ (հասցե) From՝ (Type) To: (Անուն) To: (Հասցե) Դեպի՝ (Type) CC: (Անուն) CC: (Հասցե) CC: (Type) BCC: ( Անվանում) BCC: (Հասցե) BCC: (Տեսակ) Վճարային տեղեկատվության Կատեգորիաներ Կարևորություն Վազքը զգայունություն

Ես փորձեցի ավելացնել «Կարևորությունը» և այն աշխատում է, բայց ես կգնահատեի, եթե որևէ մեկը կարողանա տրամադրել մյուս դաշտերի կոդը: շնորհակալություն!!
excWks-ի հետ
.Cells(1, 1) = "Subject"
.Cells(1, 2) = «Ստացվել է»
.Cells(1, 3) = «Ուղարկող»
Բջիջներ (1, 4) = «Մարմին»
.Cells(1, 5) = «Կարևորություն»
Վերջ
introw = 2
Յուրաքանչյուր olkMsg-ի համար olkFld.Items-ում
«Միայն արտահանել հաղորդագրություններ, ոչ անդորրագրեր կամ նշանակման հարցումներ և այլն։
Եթե ​​olkMsg.Class = olMail Այնուհետեւ
«Ավելացրեք տող յուրաքանչյուր դաշտի համար այն հաղորդագրության մեջ, որը ցանկանում եք արտահանել
excWks.Cells(intRow, 1) = olkMsg.Subject
excWks.Cells(intRow, 2) = olkMsg.ReceivedTime
excWks.Cells (intRow, 3) = GetSMTPAaddress (olkMsg, intVersion)
excWks.Cells(intRow, 4) = olkMsg.Body
excWks.Cells(intRow, 5) = olkMsg.Կարևորություն
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
Ողջույն, խնդրում ենք ստուգել ստորև նշված կոդը ձեր կարիքներին համապատասխան.
Const MACRO_NAME = "Export Outlook Folders to Excel"

Sub ExportMain ()

ExportToExcel «destination_folder_path\A.xlsx», «your_email_accouny\folder\subfolder_1»

ExportToExcel «destination_folder_path\B.xlsx», «your_email_accouny\folder\subfolder_2»

MsgBox «Գործընթացն ավարտված է», vbInformation + vbOKOnly, MACRO_NAME

Վերջ Sub

Sub ExportToExcel (strՖայլի անունը որպես տող, strFolderPath որպես տող)

Dim olkMsg Որպես օբյեկտ

Dim olkFld որպես օբյեկտ

Dim excApp-ը որպես օբյեկտ

Dim excWkb որպես օբյեկտ

Dim excWks-ը որպես օբյեկտ

Dim intRow որպես ամբողջ թիվ

Dim intVersion-ը որպես ամբողջ թիվ

Եթե ​​strFilename <> "" Ապա

Եթե ​​strFolderPath <> "" Ապա

Սահմանել olkFld = OpenOutlookFolder (strFolderPath)

Եթե ​​TypeName(olkFld) <> «Ոչինչ» Ապա

intVersion = GetOutlookVersion ()

Սահմանել excApp = CreateObject («Excel.Application»)

Սահմանել excWkb = excApp.Workbooks.Add()

Սահմանել excWks = excWkb.ActiveSheet

«Գրեք Excel-ի սյունակների վերնագրերը

excWks-ի հետ

.Cells(1, 1) = "Subject"

Բջիջներ (1, 2) = «Մարմին»

.Cells(1, 3) = «Ստացվել է»

.Cells(1, 4) = "From: (Name)"

.Cells(1, 5) = "From: (Հասցե)"

.Cells(1, 6) = "From: (Type)"

.Cells(1, 7) = "Ում՝ (անուն)"

.Cells(1, 8) = "Դեպի. (Հասցե)"

.Cells(1, 9) = "To: (Type)"

.Cells(1, 10) = "CC: (Անուն)"

.Cells(1, 11) = "CC: (Հասցե)"

.Cells(1, 12) = "CC: (Type)"

.Cells(1, 13) = "BCC. (Անուն)"

.Cells(1, 14) = "BCC: (Հասցե)"

.Cells(1, 15) = "BCC. (տեսակ)"

.Cells(1, 16) = «Վճարման տեղեկատվություն»

.Cells(1, 17) = "Categories"

.Cells(1, 18) = «Կարևորություն»

.Cells(1, 19) = «Վազքը»

.Cells(1, 20) = «Զգայունություն»

Վերջ

introw = 2

Յուրաքանչյուր olkMsg-ի համար olkFld.Items-ում

«Միայն արտահանել հաղորդագրություններ, ոչ անդորրագրեր կամ նշանակման հարցումներ և այլն։

Եթե ​​olkMsg.Class = olMail Այնուհետեւ

«Ավելացրեք տող յուրաքանչյուր դաշտի համար այն հաղորդագրության մեջ, որը ցանկանում եք արտահանել

excWks.Cells(intRow, 1) = olkMsg.Subject

excWks.Cells(intRow, 2) = olkMsg.Body

excWks.Cells(intRow, 3) = olkMsg.ReceivedTime

excWks.Cells(intRow, 4) = olkMsg.SenderName

excWks.Cells (intRow, 5) = GetAddress (olkMsg.Sender, intVersion)

excWks.Cells(intRow, 6) = olkMsg.Sender.Type

excWks.Cells(intRow, 7) = GetRecipientsName(olkMsg, 1, 1, intVersion)

excWks.Cells(intRow, 8) = GetRecipientsName(olkMsg, 1, 2, intVersion)

excWks.Cells(intRow, 9) = GetRecipientsName(olkMsg, 1, 3, intVersion)

excWks.Cells(intRow, 10) = GetRecipientsName(olkMsg, 2, 1, intVersion)

excWks.Cells(intRow, 11) = GetRecipientsName(olkMsg, 2, 2, intVersion)

excWks.Cells(intRow, 12) = GetRecipientsName(olkMsg, 2, 3, intVersion)

excWks.Cells(intRow, 13) = GetRecipientsName(olkMsg, 3, 1, intVersion)

excWks.Cells(intRow, 14) = GetRecipientsName(olkMsg, 3, 2, intVersion)

excWks.Cells(intRow, 15) = GetRecipientsName(olkMsg, 3, 3, intVersion)

excWks.Cells(intRow, 16) = olkMsg.BillingInformation

excWks.Cells(intRow, 17) = olkMsg.Categories

excWks.Cells(intRow, 18) = olkMsg.Կարևորություն

excWks.Cells(intRow, 19) = olkMsg.Mileage

excWks.Cells(intRow, 20) = olkMsg.Sensitivity

intRow = intRow + 1

Վերջ: Եթե

հաջորդ

Սահմանել olkMsg = Ոչինչ

excWkb.SaveAs strFilename

excWkb.Փակել

Ուրիշ

MsgBox ««» և strFolderPath & «» պանակը գոյություն չունի Outlook-ում։, vbCritical + vbOKOnly, MACRO_NAME

Վերջ: Եթե

Ուրիշ

MsgBox «Պանակի ուղին դատարկ էր», vbCritical + vbOKOnly, MACRO_NAME

Վերջ: Եթե

Ուրիշ

MsgBox «Ֆայլի անունը դատարկ էր», vbCritical + vbOKOnly, MACRO_NAME

Վերջ: Եթե



Սահմանել olkMsg = Ոչինչ

Սահմանել olkFld = Ոչինչ

Սահմանել excWks = Ոչինչ

Սահմանել excWkb = Ոչինչ

Սահմանել excApp = Ոչինչ

Վերջ Sub



Հանրային գործառույթ OpenOutlookFolder (strFolderPath որպես տող) որպես Outlook.MAPIFolder

Dim arrFolders As Variant

Dim varFolder As Variant

Dim bolBeyondRoot As Boolean

Ս.թ. սխալի Ռեզյումե Next

Եթե ​​strFolderPath = "" Ապա

Սահմանել OpenOutlookFolder = Ոչինչ

Ուրիշ

Do while Left(strFolderPath, 1) = "\"

strFolderPath = Right(strFolderPath, Len(strFolderPath) - 1)

Հանգույց

arrFolders = Split(strFolderPath, «\»)

Յուրաքանչյուր varFolder-ի համար arrFolders-ում

Ընտրեք Case bolBeyondRoot

Գործը կեղծ է

Սահմանել OpenOutlookFolder = Outlook.Session.Folders(varFolder)

bolBeyondRoot = Ճշմարիտ

Գործը ճիշտ է

Սահմանել OpenOutlookFolder = OpenOutlookFolder.Folders(varFolder)

Վերջ ընտրեք

Եթե ​​Սխալ.Թիվ <> 0 Ապա

Սահմանել OpenOutlookFolder = Ոչինչ

Ելք For

Վերջ: Եթե

հաջորդ

Վերջ: Եթե

Սխալի դեպքում GoTo 0

End գործառույթը



GetOutlookVersion() ֆունկցիան որպես ամբողջ թիվ

Dim arrVer Որպես տարբերակ

arrVer = Split (Outlook.Version, ".")

GetOutlookVersion = arrVer (0)

End գործառույթը



SMTPEX (Entry As AddressEntry) ֆունկցիան որպես տող

Dim olkPA As Outlook.PropertyAccessor

Ս.թ. սխալի Ռեզյումե Next

Սահմանել olkPA = Entry.PropertyAccessor

SMTPEX = olkPA.GetProperty («http://schemas.microsoft.com/mapi/proptag/0x5D01001E»)

Սխալի դեպքում GoTo 0

Սահմանել olkPA = Ոչինչ

End գործառույթը



GetAddress ֆունկցիան (Entry As AddressEntry, intOutlookVersion As Integer) որպես տող

Dim olkEnt Որպես օբյեկտ

Ս.թ. սխալի Ռեզյումե Next

Ընտրեք Case intOutlookVersion

Գործը < 14 է

Եթե ​​Entry.Type = «EX» Ապա

GetAddress = SMTPEX (Մուտք)

Ուրիշ

GetAddress = Entry.Address

Վերջ: Եթե

Այլ դեպք

Եթե ​​Entry.AddressEntryUserType = olExchangeUserAddressEntry Ապա

Սահմանել olkEnt = Entry.GetExchangeUser

GetAddress = olkEnt.PrimarySmtpAddress

Ուրիշ

GetAddress = Entry.Address

Վերջ: Եթե

Վերջ ընտրեք

Սխալի դեպքում GoTo 0

Սահմանել olkEnt = Ոչինչ

End գործառույթը



GetRecipientsName ֆունկցիան (տարրը որպես MailItem, rcpType As Integer, Ret As Integer, IntOutlookVersion որպես Integer) Որպես տող

Dim xRcp որպես ստացող

Dim xNames As String

xNames = ""

Յուրաքանչյուր xRcp In Item.Recipients-ի համար

Եթե ​​xRcp.Type = rcpType Այնուհետեւ

Եթե ​​Ret = 1 Ապա

Եթե ​​xNames = "" Ապա

xNames = xRcp.Name

Ուրիշ

xNames = xNames & "; " & xRcp.Name

Վերջ: Եթե

ElseIf Ret = 2 Ապա

Եթե ​​xNames = "" Ապա

xNames = GetAddress (xRcp.AddressEntry, intOutlookVersion)

Ուրիշ

xNames = xNames & "; " & GetAddress (xRcp.AddressEntry, intOutlookVersion)

Վերջ: Եթե

ElseIf Ret = 3 Ապա

Եթե ​​xNames = "" Ապա

xNames = xRcp.AddressEntry.Type

Ուրիշ

xNames = xNames & "; " & xRcp.AddressEntry.Type

Վերջ: Եթե

Վերջ: Եթե

ElseIf xRcp.Type = rcpType Այնուհետեւ

Եթե ​​Ret = 1 Ապա

Եթե ​​xNames = "" Ապա

xNames = xRcp.Name

Ուրիշ

xNames = xNames & "; " & xRcp.Name

Վերջ: Եթե

ElseIf Ret = 2 Ապա

Եթե ​​xNames = "" Ապա

xNames = GetAddress (xRcp.AddressEntry, intOutlookVersion)

Ուրիշ

xNames = xNames & "; " & GetAddress (xRcp.AddressEntry, intOutlookVersion)

Վերջ: Եթե

ElseIf Ret = 3 Ապա

Եթե ​​xNames = "" Ապա

xNames = xRcp.AddressEntry.Type

Ուրիշ

xNames = xNames & "; " & xRcp.AddressEntry.Type

Վերջ: Եթե

Վերջ: Եթե

ElseIf xRcp.Type = rcpType Այնուհետեւ

Եթե ​​Ret = 1 Ապա

Եթե ​​xNames = "" Ապա

xNames = xRcp.Name

Ուրիշ

xNames = xNames & "; " & xRcp.Name

Վերջ: Եթե

ElseIf Ret = 2 Ապա

Եթե ​​xNames = "" Ապա

xNames = GetAddress (xRcp.AddressEntry, intOutlookVersion)

Ուրիշ

xNames = xNames & "; " & GetAddress (xRcp.AddressEntry, intOutlookVersion)

Վերջ: Եթե

ElseIf Ret = 3 Ապա

Եթե ​​xNames = "" Ապա

xNames = xRcp.AddressEntry.Type

Ուրիշ

xNames = xNames & "; " & xRcp.AddressEntry.Type

Վերջ: Եթե

Վերջ: Եթե

Վերջ: Եթե

հաջորդ

GetRecipientsName = xNames

End գործառույթը




Հուսով եմ, որ դա ձեզ համար է:
Amanda
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
ExporttoExcel ենթակետում կարող եք ավելացնել մարմինը

«Գրեք Excel-ի սյունակների վերնագրերը
excWks-ի հետ
.Cells(1, 1) = "Subject"
.Cells(1, 2) = «Ստացվել է»
.Cells(1, 3) = «Ուղարկող»
Բջիջներ (1, 4) = «Մարմին»
Վերջ
introw = 2
Յուրաքանչյուր olkMsg-ի համար olkFld.Items-ում
«Միայն արտահանել հաղորդագրություններ, ոչ անդորրագրեր կամ նշանակման հարցումներ և այլն։
Եթե ​​olkMsg.Class = olMail Այնուհետեւ
«Ավելացրեք տող յուրաքանչյուր դաշտի համար այն հաղորդագրության մեջ, որը ցանկանում եք արտահանել
excWks.Cells(intRow, 1) = olkMsg.Subject
excWks.Cells(intRow, 2) = olkMsg.ReceivedTime
excWks.Cells (intRow, 3) = GetSMTPAaddress (olkMsg, intVersion)
excWks.Cells(intRow, 4) = olkMsg.Body
intRow = intRow + 1
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
Ողջույն, հուսով եմ, որ ինչ-որ մեկը կարող է ինձ օգնել այստեղ, ես գործնականում չգիտեմ VB-ի մասին, բայց կարողացել եմ մինչ այժմ այս սցենարը աշխատել ինձ համար:

Այնուամենայնիվ, ես ընդհանուր առմամբ իմ մուտքի արկղի տակ ունեմ մոտ 1500 թղթապանակ և ենթաթղթապանակ, և ես իսկապես կցանկանայի մի պարզ սկրիպտ՝ արտահանելու բոլոր էլփոստի հասցեն, որին ես ուղարկել եմ՝ թեմայի տողով և ամսաթվով Excel-ի առանձին սյունակներում:

Ես օրեր շարունակ որոնել եմ և փորձել եմ բազմաթիվ տարբեր կայքեր, բայց չեմ կարող ստանալ որևէ այլ կոդ աշխատելու համար, քան այս մեկը:


Հնարավո՞ր է այն, ինչ ես խնդրում եմ: Եթե ​​այո, կա՞ որևէ մեկը այնտեղ, որը բավականաչափ բարի և խելացի է, ով կօգնի ինձ հասնել ինձ անհրաժեշտ սցենարը:
Ես ենթադրում եմ, որ դա ինչ-որ կապ ունի այս մասի հետ.


Sub ExportMain ()

ExportToExcel «destination_folder_path\A.xlsx», «your_email_accouny\folder\subfolder_1»

ExportToExcel «destination_folder_path\B.xlsx», «your_email_accouny\folder\subfolder_2»

MsgBox «Գործընթացն ավարտված է», vbInformation + vbOKOnly, MACRO_NAME

Վերջ Sub


Շնորհակալություն առաջադեմում
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
Ողջու՜յն,
Ես պարզապես գործարկեցի այս մակրոն, որը լավ է աշխատում:
Ես դա հասկանում եմ արտահայտություններում
excWks.Cells(intRow, 1) = olkMsg.Subject
excWks.Cells(intRow, 2) = olkMsg.ReceivedTime
excWks.Cells (intRow, 3) = GetSMTPAaddress (olkMsg, intVersion)

olkMsg.*-ը և GetSMTPAddress-ը (olkMsg, intVersion) դուրս են բերում իրեր Outlook-ից:

Ո՞րն է այն փաստարկը, որով կարելի է ստանալ այն հասցեն, որին ուղարկվել է նամակը:

Outlook-ի Export Wizard-ն օգտագործելիս հնարավոր է արտահանել այս հասցեն, այնպես որ, ես ենթադրում եմ, որ դա հնարավոր կլինի անել այս մակրոյով (որոշ փոփոխություններով):
Ինչ-որ մեկը կարո՞ղ է օգնել:

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

User=սահմանված տեսակը սահմանված չէ

62-րդ տողում «Հանրային գործառույթ OpenOutlookFolder(strFolderPath որպես տող) As Outlook.MAPIFolder»

Ես արդեն ճշտել եմ ուղին հետևյալ կերպ.

ExportToExcel «C:\Users\kudus\Documents\MailExportTest\f1\A.xlsx», «myname@mydomain.com\Inbox\Black Hat Webcast»
ExportToExcel «C:\Users\\Documekudus\Documents\MailExportTest\f2\B.xlsx», «myname@mydomain.com\Inbox\CPD\Kaplan Training»

Ես օգտագործում եմ Outlook 2016-ը, եթե դա անհրաժեշտ լինի
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
Ես ուղղեցի այն: Վիզուալ հիմնական պատուհանից գնացեք Գործիքներ Հղում - և «Microsoft Outlook 16.0 Օբյեկտների գրադարան» վանդակը:

Առայժմ ոչ մի մեկնաբանություն չկա
Թողեք ձեր մեկնաբանությունները
Հրապարակում որպես հյուր
×
Գնահատեք այս գրառումը.
0   Անձնավորություններ
Առաջարկվող վայրեր

Հետեւեք մեզ

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