Question

我在Outlook中运行一个例程来检查＆＃34;已发送＆＃34;文件夹，将通过公共文件夹查看是否发送电子邮件＆＃34;已发送＆＃34;文件夹需要移动到公用文件夹。这很好用。问题是我希望只有在Outlook通过Wifi上的公司LAN连接到Exchange时才能执行此例程。原因是，当员工在家中使用Outlook时，他们有时并不希望执行该例程。那么问题是如何检测Outlook是通过公司局域网还是WIFI连接的？我找到了一种通过使用此子功能和相关功能来检测我是否连接到公司网络的方法。为此，我尝试访问公司服务器上的文件。这不是那么优雅，但它让我走得那么远

Sub TestNetwork()
Dim connected As Boolean

connected = CheckForNetwork()

If connected = False Then
    MsgBox ("not connected")
Else
    MsgBox ("connected")
End If
End Sub

Function CheckForNetwork() As Boolean
On Error GoTo end
If Len(Dir("\\company_name\company_name\company_name-000\Employee\ _     
          Employee Name\*.*")) > 0 Then
    CheckForNetwork = True
End If

Exit Function
end:
End Function

这会告诉我我是否连接到我们公司的服务器，但它不会告诉我它是否通过我的家庭网络，机场或任何地方的公共WiFi点连接其他。我需要了解Outlook是通过公司网络还是通过任何其他连接进行连接。

我非常感谢你对此事的任何帮助

Answer 1

感谢Sorceri的建议，我找到了一种简单的方法来检索计算机的实际IP地址。有了这个，如果计算机通过另一个连接连接到Internet，我将能够检测到IP地址是否属于我的公司LAN。灵感来自：http://www.myengineeringworld.net/2014/12/get-public-ip-local-ip-mac-address-vba.html?m=1，最终代码如下

使用以下代码，我首先检测Outlook是在线还是离线，并且我使用GetMyPublicIP函数检索IP地址

Sub enligne_horsligne()


'olCachedConnectedDrizzle   600     The account is using cached Exchange code such that headers are downloaded first, followed by the
                                'bodies and attachments of full items.

'olCachedConnectedFull      700     The account is using cached Exchange mode on a Local Area Network or a fast connection with the Exchange server.
                                'The user can also select this state manually, disabling auto-detect logic and always downloading full items
                                'regardless of connection speed.

'olCachedConnectedHeaders   500     The account is using cached Exchange mode on a dial-up or slow connection with the Exchange server, such
                                'that only headers are downloaded. Full item bodies and attachments remain on the server.
                                'The user can also select this state manually regardless of connection speed.

'olCachedDisconnected       400     The account is using cached Exchange mode with a disconnected connection to the Exchange server.
'olCachedOffline            200     The account is using cached Exchange mode and the user has selected Work Offline from the File menu.
'olDisconnected             300     The account has a disconnected connection to the Exchange server.
'olNoExchange               0       The account does not use an Exchange server.
'olOffline                  100     The account is not connected to an Exchange server and is in the classic offline mode.
                                'This also occurs when the user selects Work Offline from the File menu.
'olOnline                   800     The account is connected to an Exchange server and is in the classic online mode.


Dim myNamespace As Outlook.NameSpace
Dim adresse_IP As String

Dim mpfInbox As Outlook.folder


Set myNamespace = Application.GetNamespace("MAPI")



 If (myNamespace.ExchangeConnectionMode = 700 Or   myNamespace.ExchangeConnectionMode = 600 Or myNamespace.ExchangeConnectionMode   = 700) Then
    MsgBox ("Outlook is online")
    MsgBox (Environ("userdomain") & "\" & Environ("username"))
 Else
    MsgBox ("Outlook is offline")
    MsgBox (Environ("userdomain") & "\" & Environ("username"))
End If

adresse_IP = GetMyPublicIP()

MsgBox ("The IP adrress is  " & adresse_IP)

End Sub

GetMyPublicIP函数是

Function GetMyPublicIP() As String
'source:  http://www.myengineeringworld.net/2014/12/get-public-ip-local-ip-mac-address-vba.html?m=1
Dim HttpRequest As Object

On Error Resume Next
'Create the XMLHttpRequest object.
Set HttpRequest = CreateObject("MSXML2.XMLHTTP")

'Check if the object was created.
If Err.Number <> 0 Then
    'Return error message.
    GetMyPublicIP = "Could not create the XMLHttpRequest object!"
    'Release the object and exit.
    Set HttpRequest = Nothing
    Exit Function
End If
On Error GoTo 0

'Create the request - no special parameters required.
HttpRequest.Open "GET", "http://myip.dnsomatic.com", False

'Send the request to the site.
HttpRequest.Send

'Return the result of the request (the IP string).
GetMyPublicIP = HttpRequest.ResponseText

End Function

检测Outlook是否通过公司LAN或Wifi连接到Microsoft Exchange

1 个答案: