?
Solved

Excel Problem - System Error &H80004005 (-2147467259) + cannot access webpage

Posted on 2012-08-27
4
Medium Priority
?
1,165 Views
Last Modified: 2012-09-10
I am getting this error message whenever I attempt to run a VBA script on Excel.


Microsoft Visual Basic

System Error &H80004005 (-2147467259).  


The code imports information from the internet, and it appears, despite having internet connection, my excel cant connect to the internet. I discovered this by using the "from web" option in the "get external data" tab, it comes up with an error saying:
this program cannot display webpage

If anyone could help, it would be much appreciated.
0
Comment
Question by:kemsypt
  • 3
4 Comments
 
LVL 36

Expert Comment

by:Norie
ID: 38336840
Is it when you run any Excel VBA code?

If it isn't can you post the code.
0
 

Author Comment

by:kemsypt
ID: 38360835
Code im trying to run is as follows:
Option Explicit

Const C_PAGE = "http://www.dealextreme.com/p/"

' ADO constants (from C:\Program Files\Common Files\System\ado\ADOVBS.INC)
Const adCmdText = &H1
Const adCmdStoredProc = &H4
Const adInteger = 3
Const adCurrency = 6
Const adVarChar = 200
Const adParamInput = &H1
Const adExecuteNoRecords = &H80

Sub GetDetails()

    ' note: use menu Tools|References to add "Microsoft VBScript Regular Expressions 5.5"
    Dim objRE As New RegExp

    Dim objConn, objRst
    Set objConn = CreateObject("ADODB.Connection")
    objConn.ConnectionString = "Provider=SQLOLEDB;Data Source=.\SQLEXPRESS;User ID=ee;Password=ee"
    objConn.Open
    Dim str_sku
    Set objRst = objConn.Execute("SELECT TOP 2 [SKU] FROM [tblDX] WHERE [LAST_UPDATE] IS NULL OR [LAST_UPDATE] < GETDATE() - 1 ORDER BY [LAST_UPDATE] DESC, ID")
    Dim arrSKUs(), intCountSKUs
    intCountSKUs = -1
    While Not objRst.EOF
        str_sku = objRst.Fields(0).Value
        intCountSKUs = intCountSKUs + 1
        ReDim Preserve arrSKUs(intCountSKUs)
        arrSKUs(intCountSKUs) = str_sku
        objRst.MoveNext
    Wend
    objRst.Close
    Set objRst = Nothing
    
    If intCountSKUs = -1 Then
        MsgBox "Nothing to update"
    Else
        Dim objXMLHTTP, strHtml, objCmd
        ' prepare update command
        Set objCmd = CreateObject("ADODB.Command")
        Set objCmd.ActiveConnection = objConn
        objCmd.CommandType = adCmdText
        objCmd.CommandText = "UPDATE [tblDX] SET [Name] = ?, [PriceUS] = ?, [PriceAUS] = ?, [Specs] = Replace(?,'<br />',char(13)), [LAST_UPDATE] = GETDATE() WHERE [SKU] = ?"
        objCmd.Parameters.Append objCmd.CreateParameter("Name", adVarChar, adParamInput, 200)
        objCmd.Parameters.Append objCmd.CreateParameter("PriceUS", adCurrency, adParamInput)
        objCmd.Parameters.Append objCmd.CreateParameter("PriceAUS", adCurrency, adParamInput)
        objCmd.Parameters.Append objCmd.CreateParameter("Specs", adVarChar, adParamInput, 500)
        objCmd.Parameters.Append objCmd.CreateParameter("SKU", adVarChar, adParamInput, 20)
        ' start below header, TODO: clear rest of sheet?
        [A3].Select
        ' get pages for each SKU to be updated
        Set objXMLHTTP = CreateObject("Microsoft.XMLHTTP")
        For Each str_sku In arrSKUs ' Array(93909, 93910) ' numbers or strings (for letters or leading zeroes)
            objCmd.Parameters(4).Value = str_sku
            ' get page html
            objXMLHTTP.Open "GET", C_PAGE & str_sku, False
            objXMLHTTP.Send
            strHtml = objXMLHTTP.ResponseText
            ' find text parts
            objRE.IgnoreCase = True
            objRE.MultiLine = True
            objRE.Pattern = "<div class=""SectionContents"">\s*Item: (.*?)\s*<br />\s*<div><font face=""Arial"" size=2>(.*?)</font></div>\s*</div>"
            Dim objMatches, objMatch
            Set objMatches = objRE.Execute(strHtml)
            If objMatches.Count > 0 Then
                ActiveCell.Value = objMatches(0).SubMatches(0)
                ActiveCell.Offset(0, 1).Value = str_sku
                ActiveCell.Offset(0, 4).Value = Replace(objMatches(0).SubMatches(1), "<br />", Chr(10))
                objCmd.Parameters(0).Value = objMatches(0).SubMatches(0)
                objCmd.Parameters(3).Value = objMatches(0).SubMatches(1) ' Replace(, "<br />", Chr(13)) ' now done in SQL!
            Else
                ActiveCell.Value = "name not found"
                ActiveCell.Offset(0, 1).Value = str_sku
                ActiveCell.Offset(0, 4).Value = "description not found"
                objCmd.Parameters(0).Value = "N/A"
                objCmd.Parameters(3).Value = "N/A"
            End If
            Set objMatches = Nothing
            ' search price US
            objRE.Pattern = "<strong>\s*Price:</strong>\s*<span id=""ctl00_content_Price"" style=""font-family:Arial;font-size:15pt;font-weight:bold;"">\$([0-9,.]+)</span>"
            Set objMatches = objRE.Execute(strHtml)
            If objMatches.Count > 0 Then
                ActiveCell.Offset(0, 2).Value = objMatches(0).SubMatches(0)
                objCmd.Parameters(1).Value = objMatches(0).SubMatches(0)
            Else
                ActiveCell.Offset(0, 2).Value = "N/A"
                objCmd.Parameters(1).Value = 0 ' default/keep existing?
            End If
            Set objMatches = Nothing
            ' search price AUD
            objRE.Pattern = "<span id='AUD'>\s*([0-9,.]+)\s*</span>"
            Set objMatches = objRE.Execute(strHtml)
            If objMatches.Count > 0 Then
                ActiveCell.Offset(0, 3).Value = objMatches(0).SubMatches(0)
                objCmd.Parameters(2).Value = objMatches(0).SubMatches(0)
            Else
                ActiveCell.Offset(0, 3).Value = "N/A"
                objCmd.Parameters(2).Value = 0 ' ?
            End If
            Set objMatches = Nothing
            ' update database
            objCmd.Execute , , adExecuteNoRecords
            ' next row
            ActiveCell.Offset(1, 0).Select
        Next
        ' clean up
        Set objRE = Nothing
        Set objXMLHTTP = Nothing
        Set objCmd.ActiveConnection = Nothing
        While objCmd.Parameters.Count > 0
            objCmd.Parameters.Delete objCmd.Parameters.Count - 1
        Wend
        Set objCmd = Nothing
        MsgBox "Update complete"
    End If
    objConn.Close
    Set objConn = Nothing
End Sub

Open in new window

0
 

Accepted Solution

by:
kemsypt earned 0 total points
ID: 38360843
I've solved Excel's lack of ability to access the internet, so that's not the issue.
0
 

Author Closing Comment

by:kemsypt
ID: 38382358
figured it out my self
0

Featured Post

[Webinar] Kill tickets & tabs using PowerShell

Are you tired of cycling through the same browser tabs everyday to close the same repetitive tickets? In this webinar JumpCloud will show how you can leverage RESTful APIs to build your own PowerShell modules to kill tickets & tabs using the PowerShell command Invoke-RestMethod.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Access developers frequently have requirements to interact with Excel (import from or output to) in their applications.  You might be able to accomplish this with the TransferSpreadsheet and OutputTo methods, but in this series of articles I will di…
This article describes how you can use Custom Document Properties to store settings and other information in your workbook so that they will be available the next time you open the workbook.
The viewer will learn how to create a normally distributed random variable in Excel, use a normal distribution to simulate the return on an investment over a period of years, Create a Monte Carlo simulation using a normal random variable, and calcul…
Enter Foreign and Special Characters Enter characters you can't find on a keyboard using its ASCII code ... and learn how to make a handy reference for yourself using Excel ~ Use these codes in any Windows application! ... whether it is a Micr…

601 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question