ISBN & webscraping macro

'README: Hi, thanks for helping me with my code. I know it's a little messy; some lines are commented out, and I promise I'll delete them as soon as I'm certain I won't end up needing them again. Some of them are incomplete code, some are versions of lines that threw errors at me, and some are leftovers from other code I found online to build this project.


Option Explicit
 Private Const xlUp As Long = -4162

Public Function GetRegex(url As String, reg As String) As String
    Dim http As Object, html As Object, objResult As Object, Regex As Object
    Set http = CreateObject("MSXML2.ServerXMLHTTP.6.0")
'    Set XMLHTTP = CreateObject("MSXML2.serverXMLHTTP")
'    XMLHTTP.Open "GET", url, False
'    XMLHTTP.setRequestHeader "Content-Type", "text/xml"
'    XMLHTTP.setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 6.1; rv:25.0) Gecko/20100101 Firefox/25.0"
'    XMLHTTP.Send
        If Len(url) < 1 Then
'            continue = False
            Exit Function
        End If
    http.Open "GET", url, False
    http.setRequestHeader "Content-Type", "text/xml"
    http.Send
    Set html = CreateObject("htmlfile")
    html.Body.innerHTML = http.responseText
    Set Regex = CreateObject("VBScript.RegExp")
    Regex.Pattern = reg
    Regex.Global = True
    If Regex.Test(http.responseText) Then
'        Set matches = Regex.Execute(http.responseText)
'        GetRegex = matches(0).SubMatches(0)
         GetRegex = Regex.Execute(http.responseText).Value
        Exit Function
    End If
'    GetRegex = ""
End Function

Sub Extract_Desk_Copy_ISBNs()
 Dim objOL As Outlook.Application
' Dim objItems As Outlook.Items
    Dim ObjItems As Selection
 Dim objFolder As Outlook.MAPIFolder
 Dim olItem As Outlook.MailItem
' Dim currentExplorer As Explorer
' Dim Selection As Selection
 Dim xlApp As Object
 Dim xlWB As Object
 Dim xlSheet As Object
'Dim vtext As Variant
   Dim vtext As String
 Dim sText As String
 Dim rCount As Long
 Dim initRow As Long
 Dim bXStarted As Boolean
 Dim enviro As String
 Dim strPath As String
 Dim Reg1 As Object
 Dim M1 As Object
 Dim M As Object
 Dim website As String
 Dim Rng As Range


enviro = CStr(Environ("USERPROFILE"))
'the path of the workbook
 strPath = "C:\foo\bar.xlsx"
     On Error Resume Next
     Set xlApp = GetObject(, "Excel.Application")
     If Err <> 0 Then
         Application.StatusBar = "Please wait while Excel source is opened ... "
         Set xlApp = CreateObject("Excel.Application")
         bXStarted = True
     End If
     On Error GoTo 0
     'Open the workbook to input the data
     Set xlWB = xlApp.Workbooks.Open(strPath)
     Set xlSheet = xlWB.Sheets("Sheet1")

    'Find the next empty line of the worksheet
     initRow = xlSheet.Range("E" & xlSheet.Rows.Count).End(xlUp).row
     rCount = initRow + 1

    Set objOL = Outlook.Application
'    Set objFolder = objOL.ActiveExplorer.CurrentFolder
'    Set objItems = objFolder.Items
    Set ObjItems = objOL.ActiveExplorer.Selection
    For Each olItem In ObjItems

     On Error Resume Next

     With olItem
      sText = olItem.Body

        Set Reg1 = CreateObject("VBScript.RegExp")
        With Reg1
            .Global = True
            .Pattern = "([0-9]{13})|(97[0-9]\-[0-9\-]{13})"
        End With
'        If Reg1.Test(sText) Then
            Set M1 = Reg1.Execute(sText)
            For Each M In M1
'               vtext = Trim(M.SubMatches(1))
               With xlSheet.Range("E" & initRow, "E" & rCount)
                    Set Rng = .Find(What:=vtext, _
                               After:=.Cells(.Cells.Count), _
                               LookIn:=xlValues, _
                               LookAt:=xlWhole, _
                               SearchOrder:=xlByRows, _
                               SearchDirection:=xlNext, _
                               MatchCase:=False)
                    If Rng Is Nothing Then
                      website = "http://isbnsearch.org/isbn/" & M.Value
                      xlSheet.Range("E" & rCount) = vtext
                      xlSheet.Range("C" & rCount) = GetRegex("website", "<h1>(.*)</h1>")
                      xlSheet.Range("D" & rCount) = GetRegex("website", "<p><strong>Author:</strong> (.*)</p>")
                      xlSheet.Range("G" & rCount) = GetRegex("website", ">*<p><strong>Publisher:</strong> (.*)</p>")
                    Else
                    End If
               End With
            Next
            rCount = rCount + 1
'        Else
'            If MsgBox("This email cound not be read. Please enter data manually.", vbOKCancel, "Error") = vbOK Then
               'If ObjItems.Count = 1 Then
                    'blah blah code to Open xlSheet
               'Else
               'End If
'            Else
'               Exit Sub
'            End If
'        End If
     End With
    Next

'''TODO: Popup dialog, "Please manually check the data for errors." Options: "Okay" [opens xlSheet] / "Later" [closes everything]
'    If MsgBox("Please manually check the data for errors. Would you like to launch Excel now?", vbYesNo, "Scan complete") = vbYes Then
        'blah blah Open xlSheet
'    Else
'    End If
     xlWB.Close 1
     If bXStarted Then
         xlApp.Quit
     End If
     Set M = Nothing
     Set M1 = Nothing
     Set Reg1 = Nothing
     Set xlApp = Nothing
     Set xlWB = Nothing
     Set xlSheet = Nothing

    Set ObjItems = Nothing
    Set objFolder = Nothing
    Set objOL = Nothing

End Sub