The way that I do this is to leverage the DocumentOpened event to check for connectivity to a central server, and if available it will download a new copy of the .vss file to a temp directory on the users computer, and then load the stencil so that it is available for the user to use.
If the server is not responding for some reason; i.e. they are working from home, or not connected to the network, then the document will operate in "Offline" mode, and will use the most recent copy of the stencil file available locally on the users hard drive instead. If you are interested in having stencils created by individual users made available to everyone
, then the code I've provided below can be tweaked a bit so that it works in reverse.
I've included some code snippets of this method below; hopefully it's clear what I am doing. :
Private Declare PtrSafe Function GetRTTAndHopCount Lib "iphlpapi.dll" _
(ByVal lDestIPAddr As LongPtr, _
ByRef lHopCount As LongPtr, _
ByVal lMaxHops As LongPtr, _
ByRef lRTT As LongPtr) As LongPtr
Const SOCKET_ERROR = 0
Private Type WSAdata
wVersion As Integer
wHighVersion As Integer
szDescription(0 To 255) As Byte
szSystemStatus(0 To 128) As Byte
iMaxSockets As Integer
iMaxUdpDg As Integer
lpVendorInfo As LongPtr
End Type
Private Type Hostent
h_name As LongPtr
h_aliases As LongPtr
h_addrtype As Integer
h_length As Integer
h_addr_list As LongPtr
End Type
Private Type IP_OPTION_INFORMATION
TTL As Byte
Tos As Byte
Flags As Byte
OptionsSize As Long
OptionsData As String * 128
End Type
Private Type IP_ECHO_REPLY
Address(0 To 3) As Byte
Status As Long
RoundTripTime As Long
DataSize As Integer
Reserved As Integer
data As LongPtr
Options As IP_OPTION_INFORMATION
End Type
Private Declare PtrSafe Function OpenProcess Lib "kernel32" (ByVal dwDesiredaccess&, _
ByVal bInherithandle&, ByVal dwProcessid&) As LongPtr
Private Declare PtrSafe Function GetExitCodeProcess Lib "kernel32" _
(ByVal hProcess As LongPtr, lpexitcode As LongPtr) As LongPtr
Const STILL_ACTIVE = &H103
Const PROCESS_QUERY_INFORMATION = &H400
Private Declare PtrSafe Function inet_addr Lib "wsock32.dll" _
(ByVal cp As String) As LongPtr
Private Declare PtrSafe Function GetHostByName Lib "wsock32.dll" Alias "gethostbyname" (ByVal hostname As String) As Long
Private Declare PtrSafe Function WSAStartup Lib "wsock32.dll" (ByVal wVersionRequired&, lpWSAdata As WSAdata) As Long
Private Declare PtrSafe Function WSACleanup Lib "wsock32.dll" () As Long
Private Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long)
Private Declare PtrSafe Function IcmpCreateFile Lib "icmp.dll" () As Long
Private Declare PtrSafe Function IcmpCloseHandle Lib "icmp.dll" (ByVal HANDLE As Long) As Boolean
Private Declare PtrSafe Function IcmpSendEcho Lib "ICMP" (ByVal IcmpHandle As Long, ByVal DestAddress As Long, ByVal RequestData As String, ByVal RequestSize As Integer, RequestOptns As IP_OPTION_INFORMATION, ReplyBuffer As IP_ECHO_REPLY, ByVal ReplySize As Long, ByVal TimeOut As Long) As Boolean
Private Declare PtrSafe 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
Private Declare PtrSafe Function DeleteUrlCacheEntry Lib "wininet.dll" Alias _
"DeleteUrlCacheEntryA" (ByVal lpszUrlName As String) As Long
Private Declare PtrSafe Function WaitForSingleObject Lib "kernel32" (ByVal _
hHandle As Long, ByVal dwMilliseconds As Long) As Long
Private Declare PtrSafe Function CloseHandle Lib "kernel32" (ByVal hObject _
As Long) As Long
Option Explicit
Public filename As String
Public results As Boolean
Public sitecode As String
Public serverNAME As String
Public URL_location As String
Public libraryFILE As String
Public libraryPATH As String
Public vVersion As Integer
Private Sub Document_DocumentOpened(ByVal Doc As IVDocument)
vVersion = Replace(Application.Version, ".0", "")
Call Call_server
Application.Documents.OpenEx libraryPATH & libraryFILE, visOpenDocked + visOpenHidden
If Visio.ActiveWindow.Windows.ItemFromID(visWinIDShapeSearch).Visible = True Then
Visio.ActiveWindow.Windows.ItemFromID(visWinIDShapeSearch).Close
End If
End Sub
Sub retrieve_settings()
serverNAME = ActiveDocument.DocumentSheet.Cells("prop.SERVER").ResultStr("")
URL_location = ActiveDocument.DocumentSheet.Cells("prop.URL").ResultStr("")
libraryFILE = ActiveDocument.DocumentSheet.Cells("prop.LIBRARYFILE").ResultStr("")
libraryPATH = ActiveDocument.DocumentSheet.Cells("prop.LIBRARYPATH").ResultStr("")
End Sub
Public Sub Call_server()
Dim hostname, s, s2 As String
Dim hFile As Long, lpWSAdata As WSAdata
Dim hHostent As Hostent, AddrList As Long
Dim Address As Long, rIP As String
Dim OptInfo As IP_OPTION_INFORMATION
Dim EchoReply As IP_ECHO_REPLY
Call retrieve_settings
Call WSAStartup(&H101, lpWSAdata)
If GetHostByName(serverNAME + String(64 - Len(serverNAME), 0)) <> SOCKET_ERROR Then
CopyMemory hHostent.h_name, ByVal GetHostByName(serverNAME + String(64 - Len(serverNAME), 0)), Len(hHostent)
CopyMemory AddrList, ByVal hHostent.h_addr_list, 4
CopyMemory Address, ByVal AddrList, 4
End If
hFile = IcmpCreateFile()
If hFile = 0 Then
MsgBox "Unable to Create File Handle"
Exit Sub
End If
OptInfo.TTL = 30
If IcmpSendEcho(hFile, Address, String(32, "A"), 32, OptInfo, EchoReply, Len(EchoReply) + 8, 2000) Then
rIP = CStr(EchoReply.Address(0)) + "." + CStr(EchoReply.Address(1)) + "." + CStr(EchoReply.Address(2)) + "." + CStr(EchoReply.Address(3))
End If
If Len(serverNAME) < 10 Then EchoReply.Status = 11010
If EchoReply.Status = 0 Then
results = True
Else
results = False
End If
If results = True Then
Call DownloadFileFromWeb
Application.Documents.OpenEx libraryPATH & libraryFILE, visOpenDocked + visOpenHidden
ElseIf results = False Then
MsgBox ("Either network connectivity to the server was not detected, or HAL.<domain>.com is currently offline." & vbCrLf & vbCrLf & "This Document will operate in localized mode." & vbCrLf & vbCrLf & "The GT [SMART] Tools will still be available, but may have limited functionality.")
Application.Documents.OpenEx libraryPATH & libraryFILE, visOpenDocked + visOpenHidden
End If
Call IcmpCloseHandle(hFile)
Call WSACleanup
End Sub
Function DownloadFileFromWeb() As Boolean
Dim URL As String, SavePath As String
Dim visioapp, visiostencil As Object
visioapp = Visio.Application
URL = URL_location & libraryFILE
SavePath = libraryPATH & libraryFILE
If results = True Then
Dim Ret As Long
DeleteUrlCacheEntry URL
On Error Resume Next
DownloadFileFromWeb = False
Ret = URLDownloadToFile(0, URL, SavePath, 0, 0)
If Ret = 0 Then DownloadFileFromWeb = True
If vVersion >= 15 Then Call download_ribbon_icons
ElseIf results = False Then
End If
End Function
Function download_ribbon_icons() As Boolean
Dim URL As String, SavePath As String
Dim filename As Variant
Dim i As Long
Dim visioapp As Object
visioapp = Visio.Application
filename = Split("browser.png,city.png,firewall.png,router-32.png,security.png,subnet.png,switch2.png", ",")
For i = LBound(filename) To UBound(filename)
URL = URL_location + filename(i)
SavePath = libraryPATH + filename(i)
Dim Ret As Long
DeleteUrlCacheEntry URL
On Error Resume Next
download_ribbon_icons = False
Ret = URLDownloadToFile(0, URL, SavePath, 0, 0)
If Ret = 0 Then download_ribbon_icons = True
Next i
End Function
