Outlook. Ինչպես հանել բոլոր URL-ները մեկ էլ.փոստից

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

VBA՝ URL-ները մեկ էլ.փոստից տեքստային ֆայլ հանելու համար

VBA մի քանի էլ. հասցեներից Excel ֆայլ հանելու համար

Office Tab - Միացրեք ներդիրներով խմբագրումը և զննարկումը Microsoft Office-ում, ինչը հեշտացնում է աշխատանքը

Կարդալ ավելին...Ներբեռնել ...

Kutools Outlook-ի համար - Բարձրացրեք Outlook-ը 100+ առաջադեմ հատկություններով բարձր արդյունավետության համար

Ավտոմատացնել էլ Auto CC / BCC, Ավտոմեքենաների փոխանցում կանոններով; ուղարկել Ավտոմատ պատասխան (Offoff Office) առանց փոխանակման սերվեր պահանջելու...
Ստացեք նման հիշեցումներ Նախազգուշացում BCC- ի համար երբ պատասխանում եք բոլորին, երբ դուք BCC ցուցակում եք, և Հիշեցրեք հավելվածները բաց թողնելիս մոռացված հավելվածների համար...
Բարելավել էլփոստի արդյունավետությունը Պատասխանել (Բոլորը) Հավելվածներով, Ավտոմատ ավելացրեք ողջույն կամ ամսաթիվ և ժամ ստորագրության կամ թեմայի մեջ, Պատասխանել բազմաթիվ էլ...
Հեշտացնել էլփոստի ուղարկումը Վերհիշել նամակները, Կցման գործիքներ (Սեղմել բոլորը, ավտոմատ պահել բոլորը...), Հեռացնել կրկնօրինակները, եւ Արագ հաշվետվություն...

Ամրապնդեք ձեր Outlook 2021 - 2010 կամ Outlook 365 այս առաջադեմ գործառույթները: Վայելեք համապարփակ 60-օրյա անվճար փորձարկումը և բարձրացրեք ձեր էլփոստի փորձը:

Կարդալ ավելին...Ներբեռնել ...

VBA՝ URL-ները մեկ էլ.փոստից տեքստային ֆայլ հանելու համար

1. Ընտրեք նամակ, որը ցանկանում եք հանել URL-ները և սեղմել ալտ + F11 հնարավորություն տալու ստեղները Microsoft Visual Basic հավելվածների համար պատուհան.

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

VBA. հանեք բոլոր URL-ները մեկ էլ.փոստից տեքստային ֆայլ:

Sub ExportUrlToTextFileFromEmail()
'UpdatebyExtendoffice20220413
  Dim xMail As Outlook.MailItem
  Dim xRegExp As RegExp
  Dim xMatchCollection As MatchCollection
  Dim xMatch As Match
  Dim xUrl As String, xSubject As String, xFileName As String
  Dim xFs As FileSystemObject
  Dim xTextFile As Object
  Dim i As Integer
  Dim InvalidArr
  On Error Resume Next
  If Application.ActiveWindow.Class = olInspector Then
    Set xMail = ActiveInspector.CurrentItem
  ElseIf Application.ActiveWindow.Class = olExplorer Then
    Set xMail = ActiveExplorer.Selection.Item(1)
  End If
  Set xRegExp = New RegExp
  With xRegExp
    .Pattern = "(https?[:]//([0-9a-z=\?:/\.&-^!#$;_])*)"
    .Global = True
    .IgnoreCase = True
  End With
  If xRegExp.test(xMail.Body) Then
    InvalidArr = Array("/", "\", "*", ":", Chr(34), "?", "<", ">", "|")
    xSubject = xMail.Subject
    For i = 0 To UBound(InvalidArr)
      xSubject = VBA.Replace(xSubject, InvalidArr(i), "")
    Next i
    xFileName = "C:\Users\Public\Downloads\" & xSubject & ".txt"
    Set xFs = CreateObject("Scripting.FileSystemObject")
    Set xTextFile = xFs.CreateTextFile(xFileName, True)
    xTextFile.WriteLine ("Export URLs:" & vbCrLf)
    Set xMatchCollection = xRegExp.Execute(xMail.Body)
    i = 0
    For Each xMatch In xMatchCollection
      xUrl = xMatch.SubMatches(0)
      i = i + 1
      xTextFile.WriteLine (i & ". " & xUrl & vbCrLf)
    Next
    xTextFile.Close
    Set xTextFile = Nothing
    Set xMatchCollection = Nothing
    Set xFs = Nothing
    Set xFolderItem = CreateObject("Shell.Application").NameSpace(0).ParseName(xFileName)
    xFolderItem.InvokeVerbEx ("open")
    Set xFolderItem = Nothing
  End If
  Set xRegExp = Nothing
End Sub

Այս կոդում այն կստեղծի նոր տեքստային ֆայլ, որն անվանվում է էլ.փոստի վերնագրի հետ և տեղադրվում է ճանապարհին. C:\Users\Public\Downloads, դուք կարող եք փոխել այն, ինչպես ձեզ հարկավոր է:

փաստաթղթի քաղվածք url 1

3: սեղմեք Գործիքներ > Սայլակ հնարավորություն ընձեռել Հղումներ – Նախագիծ 1 երկխոսություն, նշեք Microsoft VBScript կանոնավոր արտահայտություններ 5.5 վանդակում: Սեղմել OK.

փաստաթղթի քաղվածք url 1

4. Մամուլ F5 բանալին կամ կտտացնելը Վազում կոճակը գործարկելու կոդը, այժմ տեքստային ֆայլ է դուրս գալիս, և բոլոր URL-ները հանվել են դրանում:

փաստաթղթի քաղվածք url 1

ՆշումԵթե դուք Outlook 2010-ի և Outlook 365-ի օգտվող եք, խնդրում ենք նաև նշել Windows Script Host Object Model-ի վանդակը Քայլ 3-ում: Այնուհետև սեղմեք OK:

VBA մի քանի էլ. հասցեներից Excel ֆայլ հանելու համար

Եթե ցանկանում եք մի քանի ընտրված էլ. հասցեներից URL-ներ հանել Excel ֆայլի մեջ, VBA կոդը կարող է օգնել ձեզ:

VBA. հանեք բոլոր URL-ները մի քանի նամակներից Excel ֆայլ

'UpdatebyExtendoffice20220414
Dim xExcel As Excel.Application
Dim xExcelWb As Excel.Workbook
Dim xExcelWs As Excel.Worksheet

Sub ExportAllUrlsToExcelFromMultipleEmails()
  Dim xMail As MailItem
  Dim xSelection As Selection
  Dim xWordDoc As Word.Document
  Dim xHyperlink As Word.Hyperlink
  On Error Resume Next
  Set xSelection = Outlook.Application.ActiveExplorer.Selection
  If (xSelection Is Nothing) Then Exit Sub
  Set xExcel = CreateObject("Excel.Application")
  Set xExcelWb = xExcel.Workbooks.Add
  Set xExcelWs = xExcelWb.Sheets(1)
  xExcelWb.Activate
  With xExcelWs
    .Range("A1") = "Subject"
    .Range("B1") = "DisplayText"
    .Range("C1") = "Link"
  End With
  With xExcelWs.Range("A1", "C1").Font
    .Bold = True
    .Size = 12
  End With
  For Each xMail In xSelection
    Set xWordDoc = xMail.GetInspector.WordEditor
    If xWordDoc.Hyperlinks.Count > 0 Then
      For Each xHyperlink In xWordDoc.Hyperlinks
          Call ExportToExcelFile(xMail, xHyperlink)
      Next
    End If
  Next
  xExcelWs.Columns("A:C").AutoFit
  xExcel.Visible = True
End Sub

Sub ExportToExcelFile(curMail As MailItem, curHyperlink As Word.Hyperlink)
  Dim xRow As Integer
  xRow = xExcelWs.Range("A" & xExcelWs.Rows.Count).End(xlUp).Row + 1
  With xExcelWs
    .Cells(xRow, 1) = curMail.Subject
    .Cells(xRow, 2) = curHyperlink.TextToDisplay
    .Cells(xRow, 3) = curHyperlink.Address
  End With
End Sub

Այս կոդում այն հանում է բոլոր հիպերհղումները և համապատասխան ցուցադրման տեքստերը և էլ.փոստի թեմաները:

փաստաթղթի քաղվածք url 1

3: սեղմեք Գործիքներ > Սայլակ հնարավորություն ընձեռել Հղումներ – Նախագիծ 1 երկխոսություն, տիզ Microsoft Excel 16.0 օբյեկտների գրադարան և Microsoft Word 16.0 օբյեկտի գրադարան վանդակները: Սեղմել OK.

փաստաթղթի քաղվածք url 1

4. Այնուհետև տեղադրեք կուրսորը VBA կոդի մեջ, սեղմեք F5 բանալին կամ կտտացնելը Վազում կոճակը գործարկելու կոդը, այժմ աշխատանքային գրքույկ է դուրս գալիս, և բոլոր URL-ները հանվել են դրանում, այնուհետև կարող եք այն պահել թղթապանակում:

փաստաթղթի քաղվածք url 1