I'm trying to open a Chrome browser from VBA. I understand Chrome does not support ActiveX settings so I'm curious if theres any work-arounds?
Dim ie As Object
Set ie = CreateObject("ChromeTab.ChromeFrame")
ie.Navigate "google.ca"
ie.Visible = True
shell("C:\Users\USERNAME\AppData\Local\Google\Chrome\Application\Chrome.exe -url http:google.ca")
Worked here too:
Sub test544()
Dim chromePath As String
chromePath = """C:\Program Files\Google\Chrome\Application\chrome.exe"""
Shell (chromePath & " -url http:google.ca")
End Sub
I found an easier way to do it and it works perfectly even if you don't know the path where the chrome is located.
First of all, you have to paste this code in the top of the module.
Option Explicit
Private pWebAddress As String
Public Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" _
(ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, _
ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
After that you have to create this two modules:
Sub LoadExplorer()
LoadFile "Chrome.exe" ' Here you are executing the chrome. exe
End Sub
Sub LoadFile(FileName As String)
ShellExecute 0, "Open", FileName, "http://test.123", "", 1 ' You can change the URL.
End Sub
With this you will be able (if you want) to set a variable for the url or just leave it like hardcode.
Ps: It works perfectly for others browsers just changing "Chrome.exe" to opera, bing, etc.
You can use the following vba code and input them into standard module in excel. A list of websites can be entered and should be entered like this on cell A1 in Excel - www.stackoverflow.com
ActiveSheet.Cells(1,2).Value merely takes the number of website links that you have on cell B1 in Excel and will loop the code again and again based on number of website links you have placed on the sheet. Therefore Chrome will open up a new tab for each website link.
I hope this helps with the dynamic website you have got.
Sub multiplechrome()
Dim WebUrl As String
Dim i As Integer
For i = 1 To ActiveSheet.Cells(1, 2).Value
WebUrl = "http://" & Cells(i, 1).Value & """"
Shell ("C:\Program Files (x86)\Google\Chrome\Application\chrome.exe -url " & WebUrl)
Next
End Sub
The answer given by #ray above works perfectly, but make sure you are using the right path to open up the file. If you right click on your icon and click properties, you should see where the actual path is, just copy past that and it should work.
You could use selenium basic to launch and interact with Chrome. After installation you will need to add a reference to Selenium Type library.
Option Explicit
Public Sub Demo()
Dim d As WebDriver
Set d = New ChromeDriver
Const URL = "https://www.google.com/"
With d
.Start "Chrome"
.get URL
.FindElementById("lst-ib").SendKeys "Selenium basic GitHub"
.FindElementsByTag("form")(1).FindElementByCss("input[value='Google Search']").Click
'.Quit
End With
End Sub
Related
I need to do a one time download of a pipe deliminated text file in VBA. I have tried many of the solutions in other stack overflow questions but I can't seem to make any of the solutions work. It's from the internal wiki page of my firm.
The file is something like: https://wiki.somecompany/downloads/attachments/data.txt
Note: that is not a real url
Edit: I am working within excel.
I am extremely new to VBA, so the solutions I read will probably work but they were not idiot proof.
I tried many things, but the most promising looking were the solutions posted here: EXCEL VBA - To open a text file from a website
I stopped working with the first one because it seemed like you needed Mozilla for that one, and I did not know how to specify Chrome.
I messed around with the open workbook option, but I kept getting a compile error that said "Expected: =" but I don't know what the problem is or where it should be.
Edited: #Tim Williams - your solution is the closest to have anything at all happen besides just VBA errors. I got as far as turning my spreadsheet into a log in page, so I guess I need to pass a username and password somehow
You should be able to turn on the Macro Recorder and get what you want pretty quickly. In fact, you probably spent 10x more time describing the scenario, then it would take to record the code you need. Although, it is possible that you actually can't import the data using the Macro Recorder. You should still be able to import the data by referencing a CSV, which I believe is the exact same thing as a Text file.
Sub Import_CSV_File_From_URL()
Dim URL As String
Dim destCell As Range
URL = "http://www.test.com/test.csv"
Set destCell = Worksheets("test").Range("A1")
With destCell.Parent.QueryTables.Add(Connection:="TEXT;" & URL, Destination:=destCell)
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileCommaDelimiter = True
.Refresh BackgroundQuery:=False
End With
destCell.Parent.QueryTables(1).Delete
End Sub
If that doesn't work for you, simply download the file, and do the import from your hard-drive.
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 DownloadFilefromWeb()
Dim strSavePath As String
Dim URL As String, ext As String
Dim buf, ret As Long
URL = Worksheets("Sheet1").Range("A2").Value
buf = Split(URL, ".")
ext = buf(UBound(buf))
strSavePath = "C:\Users\rshuell\Desktop\Downloads\" & "DownloadedFile." & ext
ret = URLDownloadToFile(0, URL, strSavePath, 0, 0)
If ret = 0 Then
MsgBox "Download has been succeed!"
Else
MsgBox "Error"
End If
End Sub
I'm a beginner and new to Excel VBA, but I'm trying to automate some file sharing in FTP (WinSCP) by connecting to Excel and maybe creating a macro that will help. In FTP I went to Session > Generate Session URL/code > Script (script file) and the following code is there:
open ftp://myUsername:myPassword#theHostname/
# Your command 1
# Your command 2
exit
I'm assuming the open line would connect Excel to FTP. I'm referencing code from this site to put into the '# command' area: https://www.mrexcel.com/forum/excel-questions/261043-connecting-ftp-excel.html
open ftp://myUsername:myPassword#theHostname/
Option Explicit
Sub FtpTest()
MsgBox fnDownloadFile("ftp://yoursite", "username", "password", _
"The name of your file", _
"C:\The name of your file to save as")
End Sub
Function fnDownloadFile(ByVal strHostName As String, _
ByVal strUserName As String, _
ByVal strPassWord As String, _
ByVal strRemoteFileName As String, _
ByVal strLocalFileName As String) As String
'// Set a reference to: Microsoft Internet Transfer Control
'// This is the Msinet.ocx
Dim FTP As Inet 'As InetCtlsObjects.Inet
Set FTP = New Inet 'InetCtlsObjects.Inet
On Error GoTo Errh
With FTP
.URL = strHostName
.Protocol = 2
.UserName = strUserName
.Password = strPassWord
.Execute , "Get " + strRemoteFileName + " " + strLocalFileName
Do While .StillExecuting
DoEvents
Loop
fnDownloadFile = .ResponseInfo
End With
Xit:
Set FTP = Nothing
Exit Function
Errh:
fnDownloadFile = "Error:-" & Err.Description
Resume Xit
End Function
exit
I did as this site said to go to VBA Editor > Tools > reference and check off Microsoft Internet Control.
1) Am I using the code right? Did I place it in the right area (in the '# command' area)? And right now I put the entire code in a Command Button, but when I click it it just gives me a Syntax Error highlighting the first line:
Private Sub CommandButton1_Click())
2) Do I leave the Msgbox on the 3rd line as is to wait for user input or do I fill out with my username/password/hostname? (I'm not very good with functions in VBA yet) If I do fill it out in the code, what do I put for the "yoursite" value since I'm not accessing a website?
I'm sorry I'm so confused :( Any help would be great and thank you in advance!
I think that You should take a look here - Excel VBA reference for Inet objects
it is shown here how to add refernce for INet objects in vba. Furthermore when You just want to test if the code works, instead of assigning macro to button and so on, if You use "Function" then when You go to worksheet cell and start to type =fnDown ... You should see Your macro - there You can put Your function parameters. However first of all You have to take care of the reference to Inet.
This link might also be helpful: VBA Excel and FTP with MSINET.OCX and Inet type
I think I've stumbled upon a bug in Excel - I'd really like to verify it with someone else though.
The bug occurs when reading the Workbook.VBProject.HelpFile property when the workbook has been opened with the opening application's .AutomationSecurity property set to ForceDisable. In that case this string property returns a (probably) malformed Unicode string, which VBA in turn displays with question marks. Running StrConv(..., vbUnicode) on it makes it readable again, but it sometimes looses the last character this way; this might indicate that the unicode string is indeed malformed or such, and that VBA therefore tries to convert it first and fails.
Steps to reproduce this behaviour:
Create a new Excel workbook
Go to it's VBA project (Alt-F11)
Add a new code module and add some code to it (like e.g. Dim a As Long)
Enter the project's properties (menu Tools... properties)
Enter "description" as Project description and "abc.hlp" as Help file name
Save the workbook as a .xlsb or .xlsm
Close the workbook
Create a new Excel workbook
Go to it's VBA project (Alt-F11)
Add a fresh new code module
Paste the code below in it
Adjust the path on the 1st line so it points to the file you created above
Run the Test routine
The code to use:
Const csFilePath As String = "<path to your test workbook>"
Sub TestSecurity(testType As String, secondExcel As Application, security As MsoAutomationSecurity)
Dim theWorkbook As Workbook
secondExcel.AutomationSecurity = security
Set theWorkbook = secondExcel.Workbooks.Open(csFilePath)
Call MsgBox(testType & " - helpfile: " & theWorkbook.VBProject.HelpFile)
Call MsgBox(testType & " - helpfile converted: " & StrConv(theWorkbook.VBProject.HelpFile, vbUnicode))
Call MsgBox(testType & " - description: " & theWorkbook.VBProject.Description)
Call theWorkbook.Close(False)
End Sub
Sub Test()
Dim secondExcel As Excel.Application
Set secondExcel = New Excel.Application
Dim oldSecurity As MsoAutomationSecurity
oldSecurity = secondExcel.AutomationSecurity
Call TestSecurity("enabled macros", secondExcel, msoAutomationSecurityLow)
Call TestSecurity("disabled macros", secondExcel, msoAutomationSecurityForceDisable)
secondExcel.AutomationSecurity = oldSecurity
Call secondExcel.Quit
Set secondExcel = Nothing
End Sub
Conclusion when working from Excel 2010:
.Description is always readable, no matter what (so it's not like all string properties behave this way)
xlsb and xlsm files result in an unreadable .HelpFile only when macros are disabled
xls files result in an unreadable .HelpFile in all cases (!)
It might be even weirder than that, since I swear I once even saw the questionmarks-version pop up in the VBE GUI when looking at such a project's properties, though I'm unable to reproduce that now.
I realize this is an edge case if ever there was one (except for the .xls treatment though), so it might just have been overlooked by Microsoft's QA department, but for my current project I have to get this working properly and consistently across Excel versions and workbook formats...
Could anyone else test this as well to verify my Excel installation isn't hosed? Preferably also with another Excel version, to see if that makes a difference?
Hopefully this won't get to be a tumbleweed like some of my other posts here :) Maybe "Tumbleweed generator" might be a nice badge to add...
UPDATE
I've expanded the list of properties to test just to see what else I could find, and of all the VBProject's properties (BuildFileName, Description, Filename, HelpContextID, HelpFile, Mode, Name, Protection and Type) only .HelpFile has this problem of being mangled when macros are off.
UPDATE 2
Porting the sample code to Word 2010 and running that exhibits exactly the same behaviour - the .HelpFile property is malformed when macros are disabled. Seems like the code responsible for this is Office-wide, probably in a shared VBA library module (as was to be expected TBH).
UPDATE 3
Just tested it on Excel 2007 and 2003, and both contain this bug as well. I haven't got an Excel XP installation to test it out on, but I can safely say that this issue already has a long history :)
I've messed with the underlying binary representation of the strings in question, and found out that the .HelpFile string property indeed returns a malformed string.
The BSTR representation (underwater binary representation for VB(A) strings) returned by the .HelpFile property lists the string size in the 4 bytes in front of the string, but the following content is filled with the ASCII representation and not the Unicode (UTF16) representation as VBA expects.
Parsing the content of the BSTR returned and deciding for ourselves which format is most likely used fixes this issue in some circumstances. Another issue is unfortunately at play here as well: it only works for even-length strings... Odd-length strings get their last character chopped off, their BSTR size is reported one short, and the ASCII representation just doesn't include the last character either... In that case, the string cannot be recovered fully.
The following code is the example code in the question augmented with this fix. The same usage instructions apply to it as for the original sample code. The RecoverString function performs the needed magic to, well, recover the string ;) DumpMem returns a 50-byte memory dump of the string you pass to it; use this one to see how the memory is layed out exactly for the passed-in string.
Const csFilePath As String = "<path to your test workbook>"
Private Declare Sub CopyMemoryByte Lib "kernel32" Alias "RtlMoveMemory" (ByRef Destination As Byte, ByVal Source As Long, ByVal Length As Integer)
Private Declare Sub CopyMemoryWord Lib "kernel32" Alias "RtlMoveMemory" (ByRef Destination As Integer, ByVal Source As Long, ByVal Length As Integer)
Private Declare Sub CopyMemoryDWord Lib "kernel32" Alias "RtlMoveMemory" (ByRef Destination As Long, ByVal Source As Long, ByVal Length As Integer)
Function DumpMem(text As String) As String
Dim textAddress As LongPtr
textAddress = StrPtr(text)
Dim dump As String
Dim offset As Long
For offset = -4 To 50
Dim nextByte As Byte
Call CopyMemoryByte(nextByte, textAddress + offset, 1)
dump = dump & Right("00" & Hex(nextByte), 2) & " "
Next
DumpMem = dump
End Function
Function RecoverString(text As String) As String
Dim textAddress As LongPtr
textAddress = StrPtr(text)
If textAddress <> 0 Then
Dim textSize As Long
Call CopyMemoryDWord(textSize, textAddress - 4, 4)
Dim recovered As String
Dim foundNulls As Boolean
foundNulls = False
Dim offset As Long
For offset = 0 To textSize - 1
Dim nextByte As Byte
Call CopyMemoryByte(nextByte, textAddress + offset, 1)
recovered = recovered & Chr(CLng(nextByte) + IIf(nextByte < 0, &H80, 0))
If nextByte = 0 Then
foundNulls = True
End If
Next
Dim isNotUnicode As Boolean
isNotUnicode = isNotUnicode Mod 2 = 1
If foundNulls And Not isNotUnicode Then
recovered = ""
For offset = 0 To textSize - 1 Step 2
Dim nextWord As Integer
Call CopyMemoryWord(nextWord, textAddress + offset, 2)
recovered = recovered & ChrW(CLng(nextWord) + IIf(nextWord < 0, &H8000, 0))
Next
End If
End If
RecoverString = recovered
End Function
Sub TestSecurity(testType As String, secondExcel As Application, security As MsoAutomationSecurity)
Dim theWorkbook As Workbook
secondExcel.AutomationSecurity = security
Set theWorkbook = secondExcel.Workbooks.Open(csFilePath)
Call MsgBox(testType & " - helpfile: " & theWorkbook.VBProject.HelpFile & " - " & RecoverString(theWorkbook.VBProject.HelpFile))
Call MsgBox(testType & " - description: " & theWorkbook.VBProject.Description & " - " & RecoverString(theWorkbook.VBProject.Description))
Call theWorkbook.Close(False)
End Sub
Sub Test()
Dim secondExcel As Excel.Application
Set secondExcel = New Excel.Application
Dim oldSecurity As MsoAutomationSecurity
oldSecurity = secondExcel.AutomationSecurity
Call TestSecurity("disabled macros", secondExcel, msoAutomationSecurityForceDisable)
Call TestSecurity("enabled macros", secondExcel, msoAutomationSecurityLow)
secondExcel.AutomationSecurity = oldSecurity
Call secondExcel.Quit
Set secondExcel = Nothing
End Sub
I need to download the PDF files from the link below for the first/top 5 dates and save them on Desktop for instance. I have no clue how to start but also couldn't find something explicit on Google.
Do you think you can help me?
http://cetatenie.just.ro/ordine/articol-11/
I would use Internet Explorer, and automate it using an SHDocVw.InternetExplorer object (VBA reference 'Microsoft Internet Controls', ieframe.dll).
You can either (a) create a new Internet Explorer window using Set x = New SHDocVw.InternetExplorer or (b) acquire an existing Internet Explorer window using Set owins = CreateObject("Shell.Application").Windows (owins is an array, loop through it until you find one where Mid(TypeName(owins(i).Document), 1, 12) = "HTMLDocument").
Once you have an Internet Explorer ie, you can call ie.Navigate(url) to go to a website.
To wait for Internet Explorer to finish navigating before you interrogate it, you can run something like:
Do While mascot_win.Busy
Application.Wait DateAdd("s", 1, Now)
DoEvents
Loop
To get the URLs for the first five PDFs on that page, you'd need to examine the HTML of the page. There are two ways, depending on how well-formed the HTML is. If the HTML is well-written, then you can navigate the Document Object Model (the tags, like XML) with ie.Document.all(). But if the HTML is not well-formed, you may have to resort to reading the HTML from ie.Document.all(0).innerHTML.
By the looks of the link you gave, you will be looking for things like:
<li>Data de <strong>22.03.2013</strong>, numarul: 149P</li>
Once you have isolated each PDF URL (using either the attribute of the <a> tag in the DOM model or using lots of Mid() calls on the HTML), you can download it using:
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
Dim ss As String
Dim ts As String
ss = "http://blah/blah/blah.pdf"
ts = "c:\meh\blah.pdf"
URLDownloadToFile 0, ss, ts, 0, 0
Wrote a small app that accesses a bunch of search websites and puts the results in a word document, which gets run a few hundred times a day.
It saves individual search results in a number of local folders so the next time those words are searched, it grabs them locally instead of loading the website again.
This works fine - even though it's not quick. People are impressed because until a few weeks ago they did this manually by literally loading up six different search websites, searching, and then copying and pasting the results in a word document.
However, our Office's internet is unreliable, and has been down the last half a day. This has meant about 400 bad searches have been saved in the local folders, and inserted into the final documents.
When a person was searching they could tell if the internet was broken and they would do their searches later. Obviously, though, this app can't tell, and because I'm not using APIs or anything, and because I am limited to using the VBA environment (I'm not even allowed MZ tools), I need to find some way to check that the internet is working before continuing with the program flow, without relying on too many references, and preferably without screenscraping for the phrase "404 Page Not Found".
I'm not very familiar with VB, and VBA is ruining me in so many ways, so there's probably some easy way to do this, which is why I'm asking here.
Appreciate any help.
Obviously, your problem has many levels. You should start by defining "connected to the internet", and go on with developing fallback strategies that include not writing invalid files on failure.
As for the "am I connected" question, you can try tapping into the Win32 API:
Private Declare Function InternetGetConnectedState Lib "wininet.dll" _
(ByRef dwflags As Long, ByVal dwReserved As Long ) As Long
Public Function GetInternetConnectedState() As Boolean
GetInternetConnectedState = InternetGetConnectedState(0&,0&)
End Function
Though depending on your network setup (proxy/NAT/firewall restrictions etc.), Windows might have a different opinion about this than you.
Trying to GET the pages you are interested in, checking on the return status in the HTTP headers (gateway timeout, 404, whatever you expect to happen when it "doen't work) might also be a way to go.
You could use MSXML library & use XMLHttpRequest class to check for things
e.g.
On Error Resume Next
Dim request As MSXML2.XMLHTTP60
request.Open "http://www.google.com"
request.Send
Msgbox request.Status
The status will give you HTTP Status code of what happened to the request.
You might have to do some more checks, depending on your scenario.
Hope that helps.
Use the following code to check for internet connection
first anable XML v6.0 in your references
Function checkInternetConnection() As Integer
'code to check for internet connection
'by Daniel Isoje
On Error Resume Next
checkInternetConnection = False
Dim objSvrHTTP As ServerXMLHTTP
Dim varProjectID, varCatID, strT As String
Set objSvrHTTP = New ServerXMLHTTP
objSvrHTTP.Open "GET", "http://www.google.com"
objSvrHTTP.setRequestHeader "Accept", "application/xml"
objSvrHTTP.setRequestHeader "Content-Type", "application/xml"
objSvrHTTP.Send strT
If err = 0 Then
checkInternetConnection = True
Else
MsgBox "Internet connection not estableshed: " & err.Description & "", 64, "Additt !"
End If
End Function
Unfortunately, this is a bit of a difficult question to answer for a couple of reasons:
How do you define a non-working internet connection? Do you check for a valid IP address? Do you ping out? How do you know that you have permissions to check these things? How do you know that the computer's firewall/antivirus isn't causing wonky behavior?
Once you've established that the connection is working, what do you do if the connection drops mid-operation?
There are probably ways to do what you want to do, but a lot of "devil's in the details" type things tend to pop up. Do you have any way to check that the saved search is valid? If so, that would probably be the best way to do this.
Building on shakalpesh's answer and the comments to it, there are (at least) two ways to get the web page into Word without parsing the XML returned by the XMLHTTP60 object.
(NB the HTTP status code of 200 indicates that "the request has succeeded" - see here)
write the XMLHTTP60.ResponseText out to a text file and then call Documents.Open on that text file
If (xhr.Status = 200) Then
hOutFile = FreeFile
Open "C:\foo.html" For Output As #hOutFile
Print #hOutFile, xhr.responseText
Close #hOutFile
End If
// ...
Documents.Open "C:\foo.html"
This has the disadvantage that some linked elements may be lost and you'll get a message box when the file opens
check the URL status with the XMLHTTP60 object and then use Documents.Open to open the URL as before:
If (xhr.Status = 200) Then
Documents.Open "http://foo.bar.com/index.html"
End If
There is a slight chance that the XMLHTTP60 request could succeed and the Documents.Open one fail (or vice versa). Hopefully this should be a fairly uncommon event though
I found most answers here and elsewhere confusing or incomplete, so here is how to do it for idiots like me:
'paste this code in at the top of your module (it will not work elsewhere)
Private Declare Function InternetGetConnectedState Lib "wininet.dll" (ByRef dwflags As Long, ByVal dwReserved As Long) As Long
Private Const INTERNET_CONNECTION_MODEM As Long = &H1
Private Const INTERNET_CONNECTION_LAN As Long = &H2
Private Const INTERNET_CONNECTION_PROXY As Long = &H4
Private Const INTERNET_CONNECTION_OFFLINE As Long = &H20
'paste this code in anywhere
Function IsInternetConnected() As Boolean
Dim L As Long
Dim R As Long
R = InternetGetConnectedState(L, 0&)
If R = 0 Then
IsInternetConnected = False
Else
If R <= 4 Then IsInternetConnected = True Else IsInternetConnected = False
End If
End Function
'your main function/calling function would look something like this
Private Sub btnInternetFunction_Click()
If IsInternetConnected() = True Then
MsgBox ("You are connected to the Internet")
'code to execute Internet-required function here
Else
MsgBox ("You are not connected to the Internet or there is an issue with your Internet connection.")
End If
End Sub
This is what I use. I prefer it because it doesn't require any external references or DLLs.
Public Function IsConnected()
Dim objFS As Object
Dim objShell As Object
Dim objTempFile As Object
Dim strLine As String
Dim strFileName As String
Dim strHostAddress As String
Dim strTempFolder As String
strTempFolder = "C:\PingTemp"
strHostAddress = "8.8.8.8"
IsConnected = True ' Assume success
Set objFS = CreateObject("Scripting.FileSystemObject")
Set objShell = CreateObject("Wscript.Shell")
If Dir(strTempFolder, vbDirectory) = "" Then
MkDir strTempFolder
End If
strFileName = strTempFolder & "\" & objFS.GetTempName
If Dir(strFileName) <> "" Then
objFS.DeleteFile (strFileName)
End If
objShell.Run "cmd /c ping " & strHostAddress & " -n 1 -w 1 > " & strFileName, 0, True
Set objTempFile = objFS.OpenTextFile(strFileName, 1)
Do While objTempFile.AtEndOfStream <> True
strLine = objTempFile.Readline
If InStr(1, UCase(strLine), "REQUEST TIMED OUT.") > 0 Or InStr(1, UCase(strLine), "COULD NOT FIND HOST") > 0 Then
IsConnected = False
End If
Loop
objTempFile.Close
objFS.DeleteFile (strFileName)
objFS.DeleteFolder (strTempFolder)
' Remove this after testing. Function will return True or False
MsgBox IsConnected
End Function
I encourted this same problem and after googling a lot, I realized there was a simpler way to do it... It requires the user to enable the Microsoft Internet Explorer Controlers library, but that is all. The idea is that your code navigates to a website (in this case google), and after getting the webpage document (HTML). puts a value in the search box.
Sub Test1()
On Error GoTo no_internet 'Error handler when no internet
Dim IE As New SHDocVw.InternetExplorer
IE.Visible = False 'Not to show the browser when it runs
IE.navigate "www.google.com" 'navigates to google
Do While IE.ReadyState <> READYSTATE_COMPLETE 'loops until it is ready
Loop
'Here It gets the element "q" from the form "f" of the HTML document of the webpage, which is the search box in google.com
'If there is connection, it will run, quit and then go to the msgbox.
'If there is no connection, there will be an error and it will go to the error handler "no_internet" that is declared on top of the code
IE.document.forms("f").elements("q").Value = "test"
IE.Quit
MsgBox "Internet Connection: YES"
Exit Sub
no_internet:
IE.Quit
MsgBox "Internet Connection: NO" ' and here it will know that there is no connection.
End Sub