vba 使用vba检查网络连接

Checking network connection using vba

提问by Kaja

Is there any way to check NEtwork connection in vba?

有没有办法在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

但它不起作用，我收到运行时错误

回答by evenprime

What you are doing is almost correct except flip the if and else parts,

除了翻转 if 和 else 部分之外，您所做的几乎是正确的，

i.e. when Dir("O:\") = ""= You are not connected

即当Dir("O:\") = ""=你没有连接

and when it returns something means you have a connection.

当它返回一些东西时意味着你有一个连接。

The Dirfunction 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

回答by CoveGeek

I tested the solution from this link in Access 2007 VBA.

我在 Access 2007 VBA 中测试了此链接中的解决方案。

http://www.vbaexpress.com/forum/showthread.php?42466-Pinging-IP-addresses-in-Access-2007

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.

它作为一个函数调用，可以在 VBA 代码的任何地方使用，通过名称或 IP 检测网络资源的可用性，并返回一个布尔值作为结果。

回答by grego211

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.

不知道你的问题解决了没有。无论如何，我在使用 Excel VBA 时遇到了类似的问题。在我的网络上有一个磁盘站，我将这个站的共享文件夹映射为 Windows 中的网络文件夹，使用字母 M。通常，在启动我的 Windows 后，当然磁盘站已启动并运行，网络驱动器显示在 Windows 资源管理器中，但它有一个红十字（未连接）而不是带有一些绿色（已连接）的图标。只有在我在资源管理器中手动单击此网络位置后，它才会变为绿色。当第一次发出像 Dir("M:\abc") 这样的语句时，我首先希望连接也可以通过我的 Excel VBA 程序建立。但是没有结果，图标保持红色。我总是需要先在资源管理器中手动单击。最后我在 VBA 中找到了一个解决方案，在 Dir 之前使用了一个虚拟“

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")

回答by St3ve

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.

我不想使用 DLL 文件，而是想让代码运行超过 52 运行时错误，所以我使用了“on error goto”和一个标签。

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.

这样，如果文件夹不可用，您就不会收到错误消息（这对我来说是不可接受的，因为我需要其他人舒适地使用宏），代码就落入了 IF 语句，我认为它会去如果 len 函数返回 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

回答by Brian

This is similar to St3ve's answer, but in function form that returns Trueif the drive is connected, and Falseif not.

这类似于 St3ve 的答案，但以函数形式返回，True如果驱动器已连接，False如果未连接。

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 = Falseline.

我发现 Len(Dir("O:\")) 方法适用于外部驱动器，如闪存盘，但不适用于映射的网络驱动器。该函数使用 解决此问题On Error Resume Next，因此如果 O:\ 是断开连接的映射驱动器，系统将隐藏错误 52 并转到该TestNetwork = False行。

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 Booleanand replace "O:\" with DirAddress. Then use TestNetwork("O:\"), or any other directory address in quotes when you call it.

您可以通过命名函数Function TestNetwork(DirAddress As String) As Boolean并将“O:\”替换为DirAddress. 然后TestNetwork("O:\")在调用它时使用, 或引号中的任何其他目录地址。