VBA Outlook 2013: How to retrieve a Vcard from a webpage and assign to a contactitem object

Situation: I have a Webpages containing Links to a vcards. If I click on such a link, I can either retrieve this vcard in form of a contactitem or can download the vcf file.
Now I want to handle this from a macro. The vba macro is supposed to Analyse the Webpage, find the URL referring to the vcard, and create a contactitem with These vacrd Information.
The problem I'm having is, that navigating to the URL automatically Downloads the vcf file. Idon't see how I can retrieve the Information and make it accessible in the macro for further Analysis.
So simply spoken, the idea is:
   Analyse Webpage
   find URL to vcard
   retrieve vcard (as contactitem?)
   Have Information from vcard accessible for further Analysis
Can someone Point me to how I can retrieve Information and make it accessible from within the macro?
KKressAsked:
Who is Participating?

[Product update] Infrastructure Analysis Tool is now available with Business Accounts.Learn More

x
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

David LeeCommented:
Hi, KKress.

This works for me.  This solution prompts for you for a URL, then uses IE to search for links to .vcf files on the page that URL points to.  For each found link, the code downloads the file and processes it.  I don't know what you want to do with the .vcf file after the code downloads it, so for now the code just downloads it to your Temp folder and writes a debugging message.  Outlook does not have a built-in method for importing .vcf files, so if that's what you want to do, then you'll need to write some code to read and parse the .vcf file(s).  

To use this code you will need to add a reference to "Microsoft Internet Controls".

Private Declare Function URLDownloadToFile Lib "urlmon" Alias _
  "URLDownloadToFileA" (ByVal pCaller As Long, ByVal szURL As String, ByVal _
  szFileName As String, ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long
  
Sub ImportContactFromWebpage()
    Const SCRIPT_NAME = "Import Contacts From Webpage"
    Dim arrLnk As Variant, strURL As String, strLnk As String, varLnk As Variant, strTmp As String
    strURL = InputBox("Enter the URL of the page to scan for .vcf files", SCRIPT_NAME)
    If strURL = "" Then
        MsgBox "Import cancelled.", vbInformation + vbOKOnly, SCRIPT_NAME
    Else
        strTmp = Environ("TEMP") & "\Temp.vcf"
        strLnk = GetHyperlinks(strURL)
        If strLnk = "" Then
            MsgBox "No links found at " & strURL, vbInformation + vbOKOnly, SCRIPT_NAME
        Else
            arrLnk = Split(strLnk, Chr(255))
            For Each varLnk In arrLnk
                If Right(LCase(varLnk), 4) = ".vcf" Then
                    If DownloadFileFromWeb(CStr(varLnk), strTmp) Then
                        ImportVCF strTmp
                    Else
                        MsgBox "Unable to download the file " & varLnk, vbExclamation + vbOKOnly, SCRIPT_NAME
                    End If
                End If
            Next
        End If
    End If
End Sub
  
Private Function DownloadFileFromWeb(strURL As String, strPth As String)
    Dim varRet As Variant
    varRet = URLDownloadToFile(0, strURL, strPth, 0, 0)
    DownloadFileFromWeb = (varRet = 0)
End Function

Private Function GetHyperlinks(strURL As String) As String
    Const READYSTATE_COMPLETE = 4
    Dim objIE As Object, objDoc As Object, colLinks As Object, objLink As Object
    Set objIE = New InternetExplorerMedium
    objIE.Navigate2 strURL
    Do Until objIE.ReadyState = READYSTATE_COMPLETE
        DoEvents
    Loop
    Set objDoc = objIE.Document
    Set colLinks = objDoc.getElementsByTagName("a")
    If colLinks.length > 0 Then
        For Each objLink In colLinks
            GetHyperlinks = GetHyperlinks & objLink.href & Chr(255)
        Next
        GetHyperlinks = Left(GetHyperlinks, Len(GetHyperlinks) - 1)
    Else
        GetHyperlinks = ""
    End If
    Set objLink = Nothing
    Set colLinks = Nothing
    Set objDoc = Nothing
    Set objIE = Nothing
End Function

Sub ImportVCF(strFil As String)
    'Code goes here for importing the .vcf file
    Debug.Print "Importing the contact: " & strFil
End Sub

Open in new window

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
Martin LissOlder than dirtCommented:
I've requested that this question be closed as follows:

Accepted answer: 500 points for BlueDevilFan's comment #a40725368

for the following reason:

This question has been classified as abandoned and is closed as part of the Cleanup Program. See the recommendation for more details.
KKressAuthor Commented:
@BlueDevilFan: Thanks for the code and your Patience. I've been experimenting quite a while and finally decided to use the following construct:
1. Navigate to the URL (IE.navigate) and Exit the running macro (Following further on the Explorer properties didn't get me any further, as the Explorer looses any Connection to the URL called)
2. Chose "open" from the Dialog "open,save,cancel"
3. Once the vcard is open, it is displayed in a new inspector. I capture the Event "newinspector" and process from there the downloaded Contact Object. The Beauty of this is, that I can use the full object properties of the contact and I can save the contact, too.

But thanks very much anyway for investigating!
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Outlook

From novice to tech pro — start learning today.