Visio Guy

Hello again :)

I have one strange question and i`m not sure if there is a solution.
I have a template, with included macros inside.
But since i`m a new to macros and coding in general i constantly discover new thing and i want to improve my work.

I tried to put everything in a stencil, and after that to use this stencil as a reference (in VB editor -> tools -> references)
And everything is prity nice. i update somewhere - all files are up to date.
Here comes the problem.
My file is a template for me and my colleagues - and if one person has opened the file (the stencil) - the other one cannot use it.
Is there any way to go around this, but all files to be up to date at the same time ?

I'm facing a similar problem though not that bad.
In my case, I cannot modify the stencil, when another user has opened it.
I don't know what you did to make your stencils not usable at all, when others use it.

A work around could be to copy the stencil when the drawing is opened to a local directory and work with the copy.
One of the members in the forum mentioned this method not so long ago.

Hi,

we have some stencils and a template.
The code is only in one stencil.
All is maintained on a central repository via SVN:
http://en.wikipedia.org/wiki/Apache_Subversion
Our users have local check-outs on their notebooks.
As soon as a developer commits an update the users get a pop-up message with the options to view the change-log and upgrade their local checkouts.
They can ignore the message, but then it pops up again after the next reboot.
This works from company intranet and also over internet (we travel a lot).
Only the developers have full commit rights, the users are only allowed to commit to the "SuggestionBox.vss".

First we had everything on a network folder, but this is much better now.
Not only our users are happy, also developing in a team is more fun!

All you need is:
* Ask your IT to set-up a SVN server
* http://tortoisesvn.net/
* http://svnnotifier.tigris.org/
* Refer to the local checkout in: File > Options > Advanced > File Locations > Templates | Stencils

Regards,
Thomas

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 (which was not a requirement that I had when I  made this), 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


Sorry for the slow reply - I was on a trip and now i see the responses.
I`ll check the solutions you are giving!
Very interesting !