dcsimg
Results 1 to 9 of 9

Thread: Copy a URL from a specific subject mail email body into excel worksheet

  1. #1

    Thread Starter
    Hyperactive Member
    Join Date
    Sep 2009
    Posts
    289

    Copy a URL from a specific subject mail email body into excel worksheet

    I want to copy the URL/Hyperlink from an outlook email which is received daily and consists of a 2 URL/hyperlinks and I want the second URL that starts with certain text like: http://mytkportal.si/sff/kp/sfsd=21133, the part highlighted in bold is same everyday but the last number keeps changing, So I want the macro to pull that link and paste into excel worksheet cell. I have got the below code which gets the entire email body but i need only the URL/hyperlink as mentioned above.

    Code:
    Sub CopyEmailtoExcel()
    Dim olApp As Outlook.Application
    Dim olNs As Namespace
    Dim Fldr As MAPIFolder
    Dim olMi As Variant
    Dim i As Integer
    Set olApp = New Outlook.Application
    Set olNs = olApp.GetNamespace("MAPI")
    Set Fldr = olNs.GetDefaultFolder(olFolderInbox).Folders("Test")
    Set Fldr = Fldr.Folders("MyFolder")
    Set inboxItems = Fldr.Items
    
    pnldate = Format((Date - 1), "mm/dd/yyyy")
    
    Set inboxItems = Fldr.Items
    inboxItems.Sort "[ReceivedTime]", True
    For i = 1 To Fldr.Items.Count Step 1
        Set olMi = Fldr.Items(i)
            If Format(olMi.ReceivedTime, "mm/dd/yyyy") = pnldate Then
                Debug.Print olMi.ReceivedTime
                Debug.Print olMi.Subject
                If InStr(1, olMi.Subject, "Breakdown") > 0 Then
                    Sheets("Sheet1").Range("A1") = olMi.Body
                    GoTo AllDone
                End If
            End If
    Next i
    
    AllDone:
    End Sub

  2. #2
    PowerPoster
    Join Date
    Dec 2004
    Posts
    24,299

    Re: Copy a URL from a specific subject mail email body into excel worksheet

    try like
    Code:
    mylink = "http://mytkportal.si/sff/kp/sfsd="
    pos = instr(olMi.Body, mylink)
    if pos > 0 then
        Sheets("Sheet1").Range("A1") = mid(olMi.body, pos, len(mylink)+5)
    end if
    if the length of the numeric can change from 5 digits you would have to find the end position, using instr again to find the end of the link
    i do my best to test code works before i post it, but sometimes am unable to do so for some reason, and usually say so if this is the case.
    Note code snippets posted are just that and do not include error handling that is required in real world applications, but avoid On Error Resume Next

    dim all variables as required as often i have done so elsewhere in my code but only posted the relevant part

    come back and mark your original post as resolved if your problem is fixed
    pete

  3. #3

    Thread Starter
    Hyperactive Member
    Join Date
    Sep 2009
    Posts
    289

    Re: Copy a URL from a specific subject mail email body into excel worksheet

    ok. It seems to be working but I get the outlook warning message .i.e. "A program is trying to access email information stored in outlook. If this is unexpected, click deny and verify your antivirus software is uptodate. for more information about e-mail safety and how you might be able to avoid getting this warning, click help. " It shows a dropdown below the msg .i.e. Allow access for : the dropdown consists of values like 1 minute, 2 minutes, 5 minutes, 10 minutes. and then 3 buttons .i.e. Allow, Deny and Help. I have done some google search and found that I have to check few box .i.e. "Never warn me about suspicious activity (not recommended)" under programmatic access in Trust Center Settings in outlook but that is all disabled by my company IT and I know that they won't allow any exception for macros. So what's the work around, I checked the send keys as well but since the outlook warning message box appears 3 to 4 times, even that is not the option. is there any other way we can do it. Also I am not sure why this warning msg appears only for the above code and not for the below email attachment download code which i use since even in the below i am trying to download the attachments from outlook.

    Code:
        
    Sub Downloademailattachementsfromexcellist()
        Dim olApp As Object
        Dim olNS As Object
        Dim olItem As Object
        Dim olRecip As Object
        Dim olShareInbox As Object
        Dim lRow As Integer
        Dim olAttach As Object
        Dim strPath As String
        Dim strName As String
        Dim xlSheet As Worksheet
        Dim iRow as Integer
        Dim mydate As Date
        mydate = ThisWorkbook.Sheets("Email Download").Range("E2").Value
        Dim nxtday As Date
        nxtday = mydate + 1
    
            Set olApp = OutlookApp("outlook.application")
            Set olNS = olApp.GetNameSpace("MAPI")
            '
    
    
         
            Set olShareInbox = olNS.GetDefaultFolder(olFolderInbox).Folders(ThisWorkbook.Sheets("Email Download").Range("E2").Value)
            
            Set xlSheet = ActiveWorkbook.Sheets("Email Download")
            strPath = "C:\HP" & xlSheet.Range("C1").value & ""
    
            If olShareInbox.Items.Restrict("[receivedtime] > '" & mydate & "' and [receivedtime] < '" & nxtday & "'").Count = 0 Then
                MsgBox ("No mails for")
            Else
                CreateFolders strPath    'ensure the save path is present
               
                    lRow = xlSheet.Range("A" & xlSheet.Rows.Count).End(xlUp).Row 
       
               For Each olItem In olShareInbox.Items.Restrict("[receivedtime] > '" & mydate & "' and [receivedtime] < '" & nxtday & "'")
                    For iRow = 1 To lRow    'declare the variable iRow as integer           
                        If InStr(1, olItem.Subject, xlSheet.Range("B" & iRow).value & "*") > 0 Then
                            If olItem.attachments.Count > 0 Then
                                For Each olAttach In olItem.attachments
                                    strName = olAttach.FileName
                                    olAttach.SaveAsFile strPath & strName
                                    olItem.UnRead = False    
                               Next olAttach
                            End If
                            Exit For 'subject found so stop looking
                        End If
                    Next iRow
                Next olItem
    
            End If
        End Sub

  4. #4

    Thread Starter
    Hyperactive Member
    Join Date
    Sep 2009
    Posts
    289

    Re: Copy a URL from a specific subject mail email body into excel worksheet

    ok. It seems to be working but I get the outlook warning message .i.e. "A program is trying to access email information stored in outlook. If this is unexpected, click deny and verify your antivirus software is uptodate. for more information about e-mail safety and how you might be able to avoid getting this warning, click help. " It shows a dropdown below the msg .i.e. Allow access for : the dropdown consists of values like 1 minute, 2 minutes, 5 minutes, 10 minutes. and then 3 buttons .i.e. Allow, Deny and Help. I have done some google search and found that I have to check few box .i.e. "Never warn me about suspicious activity (not recommended)" under programmatic access in Trust Center Settings in outlook but that is all disabled by my company IT and I know that they won't allow any exception for macros. So what's the work around, I checked the send keys as well but since the outlook warning message box appears 3 to 4 times, even that is not the option. is there any other way we can do it. Also I am not sure why this warning msg appears only for the above code and not for the below email attachment download code which i use since even in the below i am trying to download the attachments from outlook.

    Code:
        
    Sub Downloademailattachementsfromexcellist()
        Dim olApp As Object
        Dim olNS As Object
        Dim olItem As Object
        Dim olRecip As Object
        Dim olShareInbox As Object
        Dim lRow As Integer
        Dim olAttach As Object
        Dim strPath As String
        Dim strName As String
        Dim xlSheet As Worksheet
        Dim iRow as Integer
        Dim mydate As Date
        mydate = ThisWorkbook.Sheets("Email Download").Range("E2").Value
        Dim nxtday As Date
        nxtday = mydate + 1
    
            Set olApp = OutlookApp("outlook.application")
            Set olNS = olApp.GetNameSpace("MAPI")
            '
    
    
         
            Set olShareInbox = olNS.GetDefaultFolder(olFolderInbox).Folders(ThisWorkbook.Sheets("Email Download").Range("E2").Value)
            
            Set xlSheet = ActiveWorkbook.Sheets("Email Download")
            strPath = "C:\HP" & xlSheet.Range("C1").value & ""
    
            If olShareInbox.Items.Restrict("[receivedtime] > '" & mydate & "' and [receivedtime] < '" & nxtday & "'").Count = 0 Then
                MsgBox ("No mails for")
            Else
                CreateFolders strPath    'ensure the save path is present
               
                    lRow = xlSheet.Range("A" & xlSheet.Rows.Count).End(xlUp).Row 
       
               For Each olItem In olShareInbox.Items.Restrict("[receivedtime] > '" & mydate & "' and [receivedtime] < '" & nxtday & "'")
                    For iRow = 1 To lRow    'declare the variable iRow as integer           
                        If InStr(1, olItem.Subject, xlSheet.Range("B" & iRow).value & "*") > 0 Then
                            If olItem.attachments.Count > 0 Then
                                For Each olAttach In olItem.attachments
                                    strName = olAttach.FileName
                                    olAttach.SaveAsFile strPath & strName
                                    olItem.UnRead = False    
                               Next olAttach
                            End If
                            Exit For 'subject found so stop looking
                        End If
                    Next iRow
                Next olItem
    
            End If
        End Sub

  5. #5
    PowerPoster
    Join Date
    Dec 2004
    Posts
    24,299

    Re: Copy a URL from a specific subject mail email body into excel worksheet

    it would appear your company does not want you to do this and it would be wrong for anyone here to help you by-pass their security

    as you are getting paid to do it the slow way why should you care?

    anyway this response seems to have more relevance to you other thread
    i do my best to test code works before i post it, but sometimes am unable to do so for some reason, and usually say so if this is the case.
    Note code snippets posted are just that and do not include error handling that is required in real world applications, but avoid On Error Resume Next

    dim all variables as required as often i have done so elsewhere in my code but only posted the relevant part

    come back and mark your original post as resolved if your problem is fixed
    pete

  6. #6

    Thread Starter
    Hyperactive Member
    Join Date
    Sep 2009
    Posts
    289

    Re: Copy a URL from a specific subject mail email body into excel worksheet

    Quote Originally Posted by westconn1 View Post
    it would appear your company does not want you to do this and it would be wrong for anyone here to help you by-pass their security

    as you are getting paid to do it the slow way why should you care?

    anyway this response seems to have more relevance to you other thread
    I partially agree with your comment since company don't want us to send some data through emails automatically since there could be a scenario where incorrect info gets delivered to someone and hence they apply such restriction but in my case I am simply fetching a link from an email which we receive daily...I am not sending any info through automated mail to anyone...even if I am automating something I know the company policy and how to remain compliant to it. So would ask you to advise on how to fix the issue.

  7. #7
    PowerPoster
    Join Date
    Dec 2004
    Posts
    24,299

    Re: Copy a URL from a specific subject mail email body into excel worksheet

    my rule here is never click any link in any email from anyone
    i do my best to test code works before i post it, but sometimes am unable to do so for some reason, and usually say so if this is the case.
    Note code snippets posted are just that and do not include error handling that is required in real world applications, but avoid On Error Resume Next

    dim all variables as required as often i have done so elsewhere in my code but only posted the relevant part

    come back and mark your original post as resolved if your problem is fixed
    pete

  8. #8

    Thread Starter
    Hyperactive Member
    Join Date
    Sep 2009
    Posts
    289

    Re: Copy a URL from a specific subject mail email body into excel worksheet

    Quote Originally Posted by westconn1 View Post
    my rule here is never click any link in any email from anyone
    Ok. But it's an internal email and I get it daily for some reporting...and manually downloading it takes some time...so I am trying to automate...please help me...

  9. #9
    PowerPoster
    Join Date
    Dec 2004
    Posts
    24,299

    Re: Copy a URL from a specific subject mail email body into excel worksheet

    you could try running the code from within outlook vba, see if the same problem occurs, just automate excel instead
    i do my best to test code works before i post it, but sometimes am unable to do so for some reason, and usually say so if this is the case.
    Note code snippets posted are just that and do not include error handling that is required in real world applications, but avoid On Error Resume Next

    dim all variables as required as often i have done so elsewhere in my code but only posted the relevant part

    come back and mark your original post as resolved if your problem is fixed
    pete

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  



Featured


Click Here to Expand Forum to Full Width