Checking network connection using vba - vba

Is there any way to check NEtwork connection in vba?
I am using this command:
If Dir("O:\") = "" Then
MsgBox "you have network connection"
Else
MsgBox "No Connection"
End If
but it doesnt work and I am getting a run time error

What you are doing is almost correct except flip the if and else parts,
i.e. when Dir("O:\") = "" = You are not connected
and when it returns something means you have a connection.
The Dir function is used to return the first filename from a specified directory, and list of attributes.
Sub Test_Connection()
If (Len(Dir("O:\"))) Then
MsgBox "Connected"
Else
MsgBox "No Connection"
End If
End Sub

This is similar to St3ve's answer, but in function form that returns True if the drive is connected, and False if not.
Function TestNetwork() As Boolean
On Error Resume Next 'ignore errors
If Len(Dir("O:\", vbDirectory)) = 0 Then
TestNetwork = False
Else
TestNetwork = True
End If
On Error GoTo 0 'reset error handling
End Function
I found that the Len(Dir("O:\")) method works for external drives, like a flash disk, but didn't work for a mapped network drive. The function works around this with On Error Resume Next, so if O:\ is a disconnected mapped drive, the system hides the Error 52 and goes to the TestNetwork = False line.
Call the function in your code like this:
If TestNetwork() = True Then
'Code if connected
Else
'Code if not connected
End If
You can generalize this code to test different directories by naming the function Function TestNetwork(DirAddress As String) As Boolean and replace "O:\" with DirAddress. Then use TestNetwork("O:\"), or any other directory address in quotes when you call it.

I tested the solution from this link in Access 2007 VBA.
http://www.vbaexpress.com/forum/showthread.php?42466-Pinging-IP-addresses-in-Access-2007
It works as a function call that can be used anywhere in your VBA code to detect the availibility of a network resource by name or IP and reuturn a boolean value as the result.

I don't know if your problem is solved. Anyway I had a similar issue using Excel VBA.
Having a diskstation on my network, I mapped a shared folder of this station as a network folder in Windows, using letter M. Generally, after starting my Windows, and of course diskstation is up and running, the network drive shows in Windows Explorer, but it has a red cross (not connected) instead of the icon with some green color (connected). Only after I manually click this network location in Explorer it becomes green. I first expected the connection could also be established via my Excel VBA programs, when issuing the first time a statement like Dir("M:\abc"). However there is no result, and the icon remains red. I always needed first to click manually in Explorer.
Finally I found a solution in VBA, using prior to the Dir a dummy "shellexecute ... explore M: ...", making the network drive automatically connected.
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
'...
Dim RetVal As Long
Dim hwnd As Long
RetVal = ShellExecute (hwnd, "explore", "M:", vbNullString, vbNullString, SW_SHOWNOACTIVATE)
'...
a = Dir("M:\abc")

I know this is a very old question and that my answer is not super clean (cause it uses a label), but I find it really simple and reliable.
Instead of using DLL files I just wanted to let the code run past the 52 runtime error, so I used a 'on error goto' and a label.
This way if the folder is not available, you don't get the error message (which was unacceptable for me, since I needed others to use the macros comfortably), the code just falls into the IF statement, where I thought it would go if the len function returned a 0.
On Error GoTo len_didnt_work 'this on error handler allow you to get past the 52 runtime error and treat the situation the way you want, I decided to go with a msgbox and to stop the whole sub
If Len(Dir("O:\Test\**", vbDirectory)) = 0 Then 'this is the test others have proposed, which works great as long as the folder _is_ available. If it is not I'd always just get the 52 runtime error
len_didnt_work: 'this is the label I decided to use to move forward in the code without the runtime 52 error, but it is placed inside the IF statement, it just aids it to work 'properly' (as I'd expect it to)
MsgBox "Sorry, your folder is not available",vbcritical 'msgbox to notify the user
On Error GoTo 0 'reset error handling
Exit Sub 'end sub, since I wanted to use files from my "O:\Test\" folder
End If
On Error GoTo 0`'reset error handling in case the folder _was_ available

I want to give an another spin on this as it is the issue.
I use Scripting.FileSystemObject!
The will check is a folder exist and do not require an error handling.
It works with network drive mapped and network folder.
Just will not detect if a network computer is their for example :"\server"
But "\server\folder" or "Y:" is working.
Dim Serverfolder As String
Serverfolder = "O:\"
Dim fdObj As Object
Set fdObj = CreateObject("Scripting.FileSystemObject")
If fdObj.FolderExists(Serverfolder) = False Then '= False is not needed!
'folder do not exists
else
'Folder exists
End if

Related

How do I bring a newly created Outlook email object to the foreground VBA

When I create a new Outlook email object it does not always come to the front.
None of them work consistently. They all stop the taskbar from flashing (which indicates that something has happened) but they never consistently bring it to the foreground.
I have tried:
.Display
Visible = True
Application.ActiveWindow etc
API calls such as Private Declare Function SetForegroundWindow Lib "user32" (ByVal hwnd As Long) As Long with SW_SHOW,, SW_SHOWNORMAL,, SW_MAXIMIZE
This is for Access 2016
Call AttachThreadInput(CurrentForegroundThreadID, NewForegroundThreadID, True)
lngRetVal = SetForegroundWindow(MyAppHWnd)
Call AttachThreadInput(CurrentForegroundThreadID, NewForegroundThreadID, False)
If lngRetVal <> 0 Then
'''Now that the window is active, let's restore it from the taskbar
If IsIconic(MyAppHWnd) Then
MsgBox (1)
Else
Call ShowWindow(MyAppHWnd, SW_SHOWNORMAL)
MsgBox (2)
End If
It always runs the Else part of the code, i.e. Message Box 2. I don't receive any error messages from other parts of the code either.
I finally got it. After days and days on this. I commented out
Call AttachThreadInput(CurrentForegroundThreadID, NewForegroundThreadID, False)
I wondered why that bit of code was there. It didn't make sense. Ohhhhh WOW huge. Oh and in the section where the call is made I used
Call ShowWindow(MyAppHWnd, SW_SHOWNORMAL)
I also had to change how it is received from the initial call from the module and present the result in a message box. It looks like so:
'Call FnSetForegroundWindow(strWindowTitleMine) 'This way does not work
Result = FnSetForegroundWindow(strWindowTitleMine) 'This line is absolutely necessary
If Result = True Then
MsgBox ("Success") 'This line is absolutely necessary
Else
MsgBox ("Not successful") 'This line is absolutely necessary
End If
Full credit to the person that wrote all the code that does the work. You can view it here EverythingAccess - Bring an external application window to the foreground

Excels "Refresh All" sometimes not working

I have a VBA function that opens a file, refreshes all the data connections, saves the file and the returns "true" if the refresh was successful. Here is the code:
Public Function RefreshFile(ByVal wbName As String, ByVal FilePath As String, ByVal pword As String)
Dim blTmp As Boolean
Dim wbRefresh As Workbook
blTmp = Not (IsWorkBookOpen(FilePath))
If blTmp Then
Workbooks.Open Filename:=FilePath, ReadOnly:=False, Notify:=False, WriteResPassword:=pword, IgnoreReadOnlyRecommended:=True
Else
RefreshFile = False
Exit Function
End If
Set wbRefresh = Workbooks(wbName & ".xlsx")
wbRefresh.Activate
ActiveWorkbook.RefreshAll
DoEvents
'MsgBox "complete"
wbRefresh.Close savechanges:=True
RefreshFile = True
End Function
The list opens a series of files and some are password protected and read-only suggested (hence the parameters passed). With the read-only suggested files though, files get saved with only one of the connections refreshed. Basically it refreshes the first connection and then saves the file.
I've tested this a number of times and if I stop the function after 'DoEvents' (notice the MsgBox to stop the code), then all the connections are in fact refreshed. If I don't stop the code and reopen the saved file later on, only one of the connections get refreshed. Is this an issue with 'RefreshAll' or when it goes to save the file? Perhaps I'm not opening the file with the full, appropriate permissions??
The solution is that 'enable background refresh' needs to be unchecked on each data table. Don't ask me what exactly this means, but after a lot of trial/error, I finally got it to work by unchecking the 'enable background refresh' option on the data connections for the data tables.
I looked at this myself, and when looking at the "enable background refresh", I noticed there is a button for "Refresh this connection on Refresh All". So I had to tick this for it to work for me.

Connecting to FTP from Excel to automate file sharing (VBA Beginner)

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

How does the Apple iTunes web site launch the iTunes application on my computer when I click the blue "Launch iTunes" button?

This is new to me as a desktop developer.
If I could figure out how this is accomplished, it may be relevant to some research I'm doing, specifically how to migrate thick desktop apps to a web implementation.
The more forms-oriented and lightweight graphics I can figure out, but heavyweight 3D graphics still requires some form of non-browser application.
As nearly as I can determine, iTunes installs some form of new protocol handler on my machine, corresponding to "itms", in place of "http".
This is cool and mysterious to me, almost magical. Any help or suggestions for additional reading materials and/or resources would be very welcome.
You can register "protocol handlers" with some browsers. I think there's a place in the operating system where you can regsiter your own.
See
http://msdn.microsoft.com/en-us/library/dd588696(office.11).aspx
http://blog.ryaneby.com/archives/firefox-protocol-handlers/
Creating new ones in firefox: http://ajaxian.com/archives/creating-custom-protocol-handlers-with-html-5-and-firefox
In safari: http://discussions.apple.com/thread.jspa?threadID=1280989
Special "mobile protocol handlers" are used extensively in the iPhone/iPod to launch the phone dialler, email sending, google maps and so on... http://www.iphonedevfaq.com/index.php?title=Protocols
Here's an example of how to reconfigure the mailto: protocol handler to trigger gmail rather than an external mail client: http://lifehacker.com/392287/set-firefox-3-to-launch-gmail-for-mailto-links
Simple.
Open iTunes
Most apps now-a-days have "Custom URL Schemes"
For Example - Coda (http://panic.com/coda) you can add snippets of code via:
Add Clip
In Windows this is called a Pluggable Protocol Handler. This article on CodeProject shows how to implement a pluggable protocol handler on Windows.
Note, this is more involved then just registering a new protocol in the registry, such as myprotocol:// and having it start a specific exe whenever a myprotocol:// anchor is clicked.
It actually allows your application to receive and process the request and to create response data dynamically. If your protocol will also be called programmatically this is usually important.
This may be overkill for your situation however it is handy to know about.
The easiest way is to register a filetype to your application (also called File Association), for example ".myp" and when the user press "start myapp" on the site it downloads a file "startapp.myp".
Windows will then look at the extention of the file and find that it is registered to your app and start your application with the file as a command-parameter. Your app can then read the file and do stuff depending of it contents.
Here are code to register a filetype to your application done in VB.Net:
(Example is taken from http://www.developerfusion.com/article/36/file-assocation/2/ but copied here for persistent reason, check original site for comments)
'// Registry windows api calls
Private Declare Function RegCreateKey& Lib "advapi32.DLL" Alias "RegCreateKeyA" (ByVal hKey As Long, ByVal lpszSubKey As String, ByVal lphKey As Long)
Private Declare Function RegSetValue& Lib "advapi32.DLL" Alias "RegSetValueA" (ByVal hKey As Long, ByVal lpszSubKey As String, ByVal fdwType As Long, ByVal lpszValue As String, ByVal dwLength As Long)
'// Required constants
Private Const HKEY_CLASSES_ROOT = &H80000000
Private Const MAX_PATH = 256&
Private Const REG_SZ = 1
'// procedure you call to associate the tmg extension with your program.
Private Sub MakeDefault()
Dim sKeyName As String '// Holds Key Name in registry.
Dim sKeyValue As String '// Holds Key Value in registry.
Dim ret As Long '// Holds error status if any from API calls.
Dim lphKey As Long '// Holds created key handle from RegCreateKey.
'// This creates a Root entry called "TextMagic"
sKeyName = "TextMagic" '// Application Name
sKeyValue = "TextMagic Document" '// File Description
ret = RegCreateKey&(HKEY_CLASSES_ROOT, sKeyName, lphKey)
ret = RegSetValue&(lphKey&, Empty, REG_SZ, sKeyValue, 0&)
'// This creates a Root entry called .tmg associated with "TextMagic".
sKeyName = ".tmg" '// File Extension
sKeyValue = "TextMagic" '// Application Name
ret = RegCreateKey&(HKEY_CLASSES_ROOT, sKeyName, lphKey)
ret = RegSetValue&(lphKey, Empty, REG_SZ, sKeyValue, 0&)
'//This sets the command line for "TextMagic".
sKeyName = "TextMagic" '// Application Name
If Right$(App.Path, 1) = "\" Then
sKeyValue = App.Path & App.EXEName & ".exe %1" '// Application Path
Else
sKeyValue = App.Path & "\" & App.EXEName & ".exe %1" '// Application Path
End If
ret = RegCreateKey&(HKEY_CLASSES_ROOT, sKeyName, lphKey)
ret = RegSetValue&(lphKey, "shell\open\command", REG_SZ, sKeyValue, MAX_PATH)
End Sub
Private Sub Form_Load()
'// ensure we only register once. When debugging etc, remove the SaveSetting line, so your program will
'// always attempt to register the file extension
If GetSetting(App.Title, "Settings", "RegisteredFile", 0) = 0 Then
'// associate tmg extension with this app
MakeDefault()
SaveSetting(App.Title, "Settings", "RegisteredFile", 1)
End If
'// check command line argument:
If Command$ <> Empty Then
'// we have a file to open
'// Fetch the file name from Command$ and then read the file if needed.
End If
End Sub
Just a follow-up for those who answered.
Turns out that the situation is somewhat complicated. Although about:config is available for FireFox, making the appropriate entries just doesn't work.
This link: http://support.mozilla.com/tiki-view_forum_thread.php?locale=fr&forumId=1&comments_parentId=74068 describes problems for Linux, but I can verify that the same problems also occur under Windows.
To make this work under Windows, I had to create a .REG file which contains the appropriate information, according to this link: http://kb.mozillazine.org/Register_protocol#Windows
Now it works!
Thanks for all the responses.

Check for active internet connection

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