Een invoegtoepassing bijwerken via internet

Inhoud

Inleiding
Aannames voor dit artikel
Update mechanisme
Update modi
Code
Download een Demo

Inleiding

Wanneer je een invoegtoepassing aanbiedt via je website, heb je meestal niet de mogelijkheid contact te onderhouden met de mensen die je programmeerwerk gebruiken. Het is niet ongebruikelijk dat je foutjes in je code hebt ontdekt (of erop wordt gewezen) of dat je je invoegtoepassing hebt bijgewerkt en dat je je gebruikers hiervan wilt laten profiteren. Het kan dan handig zijn als je gebruikers op de hoogte gehouden worden van zulke updates (veel applicaties hebben dergelijke functionaliteit ingebouwd, zoals Windows en vele virus scanners). Dit kleine artikel laat zien hoe je dergelijke functionaliteit in je eigen invoegtoepassingen kunt inbouwen.

Aannames voor dit artikel

Ik ga uit van de volgende zaken:

Alleen de invoegtoepassing zelf wordt bijgewerkt, niet mogelijke bijbehorende bestanden;
De naam van het bestand dat moet worden gedownload is gelijk aan de bestandsnaam van de invoegtoepassing;
De invoegtoepassing heeft een build (=versie) nummer.
Er is een html pagina op je website (of je genereert er een gebruik makend van een database en een query in enige php of asp code) welke niets anders bevat dan het build nummer (geen HTML tags om het nummer heen);
Ergens in de invoegtoepassing zal de VBA code een web query invoegen met als adres bovenstaande URL. het bereik van die webquery is "Available_Build" genoemd (invoegen, naam, definieren).

Update mechanisme

Het update proces werkt als volgt:

De invoegtoepassing controleert wanneer voor het laatst is gekeken naar updates;
Als dit meer dan 7 dagen geleden is (of nog nooit is gebeurd), dan wordt de controle gestart;
De invoegtoepassing vernieuwd de webquery vergelijkt de build nummers met elkaar;
Als het build nummer op de site hoger is, dan wordt toestemming gevraagd de nieuwere versie te downloaden;
De huidige invoetoepassing slaat zichzelf op onder een nieuwe naam, waarbij "(OldVersion)" aan de bestandsnaam wordt toegevoegd;

Noot: Ik heb geprobeerd of ik door het bestand van de invoegtoepassing als readonly aan te duiden het bestand kon verwijderen, ondanks dat deze in Excel geopend is, maar dit kon ik niet werkend krijgen. Ik heb verhalen gehoord, dat dit met een netwerk schijf WEL mogelijk is, maar ik kan dit niet reproduceren.

De nieuwe file wordt gedownload en een bericht wordt getoond dat de gebruiker Excel moet sluiten en weer openen om deze in gebruik te nemen.
Excel opent automatisch het nieuwe bestand. De code in het bestand verwijdert automatisch het bestand dat "(OldVersion)" achter haar naam heeft staan.

Update modi

De code kent twee modi, automatische updates en handmatige updates.

In het automatische geval wordt de webquery toegevoegd aan de addin, maar het bijwerken van de query gebeurt asynchroon. Een worksheet_change event wordt ingesteld, die zal reageren zodra de query haar resultaten binnen heeft (of een time-out is opgetreden). Dit wordt gedaan, zodat Excel door kan gaan met laden terwijl op de achtergrond de update check wordt uitgevoerd. Op deze manier merkt de gebruiker zo min mogelijk van eht hele proces, totdat er een update gevonden wordt.

In het handmatige geval, wordt de web query synchroon bijgewerkt (niets werkt in Excel totdat het resultaat is opgehaald). Dit is gedaan omdat het voor de gebuiker verwarrend zal zijn als er niets lijkt te gebeuren, waarna "plotseling" er een dialoogvenstertje verschijnt met een mededeling over het al dan niet bijgewerkt zijn van je applicatie.

Code

De code die het eigenlijke bijwerken uitvoert is geplaatst in een klasse module genaamd "clsUpdate", zie hieronder.

Option Explicit

'-------------------------------------------------------------------------
' Module : clsUpdate
' Company   : JKP Application Development Services (c)
' Author : Jan Karel Pieterse
' Created   : 19-2-2007
' Purpose   : Class to check for program updates
'-------------------------------------------------------------------------
Option Explicit

Public WithEvents Sht As Worksheet

#If VBA7 Then
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
#Else
Private Declare 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
#End If

Private mdtLastUpdate As Date

Private msAppName As String
Private msBuild As String
Private msCheckURL As String
Private msCurrentAddinName As String
Private msDownloadName As String
Private msTempAddInName As String
Private mbManual As Boolean

Private Sub Class_Terminate()
    Set Sht = Nothing
End Sub

Private Sub DownloadFile(strWebFilename As String, strSaveFileName As String)
' Download the file.
    URLDownloadToFile 0, strWebFilename, strSaveFileName, 0, 0
End Sub

Public Function IsThereAnUpdate(Optional bShowMsg As Boolean = False) As Boolean
    Dim sNewBuild As String
    On Error Resume Next
    SaveSetting AppName, "Updates", "LastUpdate", CStr(Int(Now))
    If Err.Number <> 0 And bShowMsg Then
        MsgBox "Error retrieving update information, please try again later.", vbInformation + vbOKOnly
    End If
End Function

Public Sub DoUpdate()
    Dim sNewBuild As String
    sNewBuild = ThisWorkbook.Names("Available_build").RefersToRange.Value
    If Len(sNewBuild) = 0 Or Len(sNewBuild) > 4 Then
        MsgBox "Unable to fetch version information, please try again later.", vbOKOnly + vbInformation
        Exit Sub
    End If
    If CLng(sNewBuild) > CLng(msBuild) Then
        If MsgBox("We have an update, do you wish to download?", vbQuestion + vbYesNo) = vbYes Then
            DownloadName = "https://jkp-ads.com/downloadscript.asp?filename=" & ThisWorkbook.Name
            If GetUpdate Then
                Application.Cursor = xlDefault
                MsgBox "Successfully updated the addin, please restart Excel to start using the new version!", vbOKOnly + vbInformation
            Else
                Application.Cursor = xlDefault
                MsgBox "Updating has failed.", vbInformation + vbOKOnly
            End If
        Else
            Application.Cursor = xlDefault
        End If
    ElseIf Manual Then
        Application.Cursor = xlDefault
        MsgBox "Your program is up to date.", vbInformation + vbOKOnly
    End If
TidyUp:
    On Error GoTo 0
    Exit Sub
End Sub

Private Sub Sht_Change(ByVal Target As Range)
    Application.Cursor = xlDefault
    If Len(Target.Value) <= 4 Then
        DoUpdate
        Application.Cursor = xlDefault
    ElseIf Manual Then
        'Query failed to refresh and was called manually
        Application.Cursor = xlDefault
        MsgBox "Unable to retrieve version information, please try again later", vbInformation + vbOKOnly
    End If
    Set Sht = Nothing
TidyUp:
    On Error GoTo 0
    Exit Sub
End Sub

Public Sub PlaceBuildQT(ByVal bManual As Boolean)
    Dim oNm As Name
    On Error GoTo LocErr
    Application.ScreenUpdating = False
    For Each oNm In ThisWorkbook.Worksheets("Sheet1").Names
        oNm.Delete
    Next
    If CInt(Left(Application.Version, 2)) > 11 Then
        ' Trick!! Somehow Excel 2007 cannot insert a web query into an add-in!!
        ThisWorkbook.IsAddin = False
    End If
    With ThisWorkbook.Worksheets("Sheet1").QueryTables.Add(Connection:= _
                                                           "URL;" & CheckURL, Destination:=ThisWorkbook.Names( _
                                                                                           "Available_Build").RefersToRange)
        .Name = "autosafebuild"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = Not bManual
        .RefreshStyle = xlOverwriteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = False
        .RefreshPeriod = 0
        .WebSelectionType = xlEntirePage
        .WebFormatting = xlWebFormattingNone
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        '  .WebDisableRedirections = False
        On Error Resume Next
        .Refresh BackgroundQuery:=Not (bManual)
        On Error GoTo 0
        If Not bManual Then
            Set Sht = ThisWorkbook.Worksheets("Sheet1")
        Else
            DoUpdate
        End If
    End With
TidyUp:
    If CInt(Left(Application.Version, 2)) > 11 Then
        ThisWorkbook.IsAddin = True
        ' Trick!! Otherwise, Excel 2007 will ask to save your add-in when it closes.
        ThisWorkbook.Saved = True
    End If
    Application.ScreenUpdating = True
    On Error GoTo 0
    Exit Sub
LocErr:
    If CInt(Left(Application.Version, 2)) > 11 Then
        ThisWorkbook.IsAddin = True
        ThisWorkbook.Saved = True
    End If
    Application.ScreenUpdating = True
    Application.Cursor = xlDefault
    If Err.Description Like "*QueryTables*" Then
        MsgBox "Error retrieving version information, please try again later.", vbInformation + vbOKOnly
        Resume TidyUp
    End If
End Sub

Public Property Get Build() As String
    Build = msBuild
End Property

Public Property Let Build(ByVal sBuild As String)
    msBuild = sBuild
End Property

Public Sub RemoveOldCopy()
    CurrentAddinName = ThisWorkbook.FullName
    TempAddInName = CurrentAddinName & "(OldVersion)"
    On Error Resume Next
    Kill TempAddInName
End Sub

Public Function GetUpdate() As Boolean
    On Error Resume Next
    'If workbook has been saved readonly, we can safely delete the file!
    If ThisWorkbook.ReadOnly Then
        Err.Clear
        Kill CurrentAddinName
    End If
    LastUpdate = Now
    ThisWorkbook.SaveAs TempAddInName
    DoEvents
    Kill CurrentAddinName
    On Error GoTo 0
    DownloadFile DownloadName, CurrentAddinName
    If Err = 0 Then GetUpdate = True
End Function

Private Property Get CurrentAddinName() As String
    CurrentAddinName = msCurrentAddinName
End Property

Private Property Let CurrentAddinName(ByVal sCurrentAddinName As String)
    msCurrentAddinName = sCurrentAddinName
End Property

Private Property Get TempAddInName() As String
    TempAddInName = msTempAddInName
End Property

Private Property Let TempAddInName(ByVal sTempAddInName As String)
    msTempAddInName = sTempAddInName
End Property

Public Property Get DownloadName() As String
    DownloadName = msDownloadName
End Property

Public Property Let DownloadName(ByVal sDownloadName As String)
    msDownloadName = sDownloadName
End Property

Public Property Get CheckURL() As String
    CheckURL = msCheckURL
End Property

Public Property Let CheckURL(ByVal sCheckURL As String)
    msCheckURL = sCheckURL
End Property

Public Property Get LastUpdate() As Date
    Dim dtNow As Date
    dtNow = Int(Now)
    mdtLastUpdate = CDate(GetSetting(AppName, "Updates", "LastUpdate", "0"))
    If mdtLastUpdate = 0 Then
        'Never checked for an update, save today!
        SaveSetting AppName, "Updates", "LastUpdate", CStr(Int(dtNow))
    End If
    LastUpdate = mdtLastUpdate
End Property

Public Property Let LastUpdate(ByVal dtLastUpdate As Date)
    mdtLastUpdate = dtLastUpdate
    SaveSetting AppName, "Updates", "LastUpdate", CStr(Int(mdtLastUpdate))
End Property

Public Property Get AppName() As String
    AppName = msAppName
End Property

Public Property Let AppName(ByVal sAppName As String)
    msAppName = sAppName
End Property

Public Property Get Manual() As Boolean
    Manual = mbManual
End Property

Public Property Let Manual(ByVal bManual As Boolean)
    mbManual = bManual
End Property

Als alternatief voor het gebruik van een webquery, kan het InternetExplorer control worden gebruikt (en is dus ook een verwijzing naar de bijbehorende bibliotheek nodig). Dan wordt de routine "IsThereAnUpdate":

Option Explicit

'-------------------------------------------------------------------------
' Module : clsUpdate
' Company   : JKP Application Development Services (c)
' Author : Jan Karel Pieterse
' Created   : 19-2-2007
' Purpose   : Class to check for program updates
'-------------------------------------------------------------------------
Option Explicit

Public WithEvents Sht As Worksheet

Private Declare 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 mdtLastUpdate As Date

Private msAppName As String
Private msBuild As String
Private msCheckURL As String
Private msCurrentAddinName As String
Private msDownloadName As String
Private msTempAddInName As String
Private mbManual As Boolean

Private Sub Class_Terminate()
    Set Sht = Nothing
End Sub

Private Sub DownloadFile(strWebFilename As String, strSaveFileName As String)
' Download the file.
    URLDownloadToFile 0, strWebFilename, strSaveFileName, 0, 0
End Sub

Public Function IsThereAnUpdate(Optional bShowMsg As Boolean = False) As Boolean
    Dim sNewBuild As String
    On Error Resume Next
    SaveSetting AppName, "Updates", "LastUpdate", CStr(Int(Now))
    If Err.Number <> 0 And bShowMsg Then
        MsgBox "Error retrieving update information, please try again later.", vbInformation + vbOKOnly
    End If
End Function

Public Sub DoUpdate()
    Dim sNewBuild As String
    sNewBuild = ThisWorkbook.Names("Available_build").RefersToRange.Value
    If Len(sNewBuild) = 0 Or Len(sNewBuild) > 4 Then
        MsgBox "Unable to fetch version information, please try again later.", vbOKOnly + vbInformation
        Exit Sub
    End If
    If CLng(sNewBuild) > CLng(msBuild) Then
        If MsgBox("We have an update, do you wish to download?", vbQuestion + vbYesNo) = vbYes Then
            DownloadName = "https://jkp-ads.com/downloadscript.asp?filename=" & ThisWorkbook.Name
            If GetUpdate Then
                Application.Cursor = xlDefault
                MsgBox "Successfully updated the addin, please restart Excel to start using the new version!", vbOKOnly + vbInformation
            Else
                Application.Cursor = xlDefault
                MsgBox "Updating has failed.", vbInformation + vbOKOnly
            End If
        Else
            Application.Cursor = xlDefault
        End If
    ElseIf Manual Then
        Application.Cursor = xlDefault
        MsgBox "Your program is up to date.", vbInformation + vbOKOnly
    End If
TidyUp:
    On Error GoTo 0
    Exit Sub
End Sub

Private Sub Sht_Change(ByVal Target As Range)
    Application.Cursor = xlDefault
    If Len(Target.Value) <= 4 Then
        DoUpdate
        Application.Cursor = xlDefault
    ElseIf Manual Then
        'Query failed to refresh and was called manually
        Application.Cursor = xlDefault
        MsgBox "Unable to retrieve version information, please try again later", vbInformation + vbOKOnly
    End If
    Set Sht = Nothing
TidyUp:
    On Error GoTo 0
    Exit Sub
End Sub

Public Sub PlaceBuildQT(ByVal bManual As Boolean)
    Dim oNm As Name
    On Error GoTo LocErr
    Application.ScreenUpdating = False
    For Each oNm In ThisWorkbook.Worksheets("Sheet1").Names
        oNm.Delete
    Next
    If CInt(Left(Application.Version, 2)) > 11 Then
        ' Trick!! Somehow Excel 2007 cannot insert a web query into an add-in!!
        ThisWorkbook.IsAddin = False
    End If
    With ThisWorkbook.Worksheets("Sheet1").QueryTables.Add(Connection:= _
                                                           "URL;" & CheckURL, Destination:=ThisWorkbook.Names( _
                                                                                           "Available_Build").RefersToRange)
        .Name = "autosafebuild"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = Not bManual
        .RefreshStyle = xlOverwriteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = False
        .RefreshPeriod = 0
        .WebSelectionType = xlEntirePage
        .WebFormatting = xlWebFormattingNone
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        '  .WebDisableRedirections = False
        On Error Resume Next
        .Refresh BackgroundQuery:=Not (bManual)
        On Error GoTo 0
        If Not bManual Then
            Set Sht = ThisWorkbook.Worksheets("Sheet1")
        Else
            DoUpdate
        End If
    End With
TidyUp:
    If CInt(Left(Application.Version, 2)) > 11 Then
        ThisWorkbook.IsAddin = True
        ' Trick!! Otherwise, Excel 2007 will ask to save your add-in when it closes.
        ThisWorkbook.Saved = True
    End If
    Application.ScreenUpdating = True
    On Error GoTo 0
    Exit Sub
LocErr:
    If CInt(Left(Application.Version, 2)) > 11 Then
        ThisWorkbook.IsAddin = True
        ThisWorkbook.Saved = True
    End If
    Application.ScreenUpdating = True
    Application.Cursor = xlDefault
    If Err.Description Like "*QueryTables*" Then
        MsgBox "Error retrieving version information, please try again later.", vbInformation + vbOKOnly
        Resume TidyUp
    End If
End Sub

Public Property Get Build() As String
    Build = msBuild
End Property

Public Property Let Build(ByVal sBuild As String)
    msBuild = sBuild
End Property

Public Sub RemoveOldCopy()
    CurrentAddinName = ThisWorkbook.FullName
    TempAddInName = CurrentAddinName & "(OldVersion)"
    On Error Resume Next
    Kill TempAddInName
End Sub

Public Function GetUpdate() As Boolean
    On Error Resume Next
    'If workbook has been saved readonly, we can safely delete the file!
    If ThisWorkbook.ReadOnly Then
        Err.Clear
        Kill CurrentAddinName
    End If
    LastUpdate = Now
    ThisWorkbook.SaveAs TempAddInName
    DoEvents
    Kill CurrentAddinName
    On Error GoTo 0
    DownloadFile DownloadName, CurrentAddinName
    If Err = 0 Then GetUpdate = True
End Function

Private Property Get CurrentAddinName() As String
    CurrentAddinName = msCurrentAddinName
End Property

Private Property Let CurrentAddinName(ByVal sCurrentAddinName As String)
    msCurrentAddinName = sCurrentAddinName
End Property

Private Property Get TempAddInName() As String
    TempAddInName = msTempAddInName
End Property

Private Property Let TempAddInName(ByVal sTempAddInName As String)
    msTempAddInName = sTempAddInName
End Property

Public Property Get DownloadName() As String
    DownloadName = msDownloadName
End Property

Public Property Let DownloadName(ByVal sDownloadName As String)
    msDownloadName = sDownloadName
End Property

Public Property Get CheckURL() As String
    CheckURL = msCheckURL
End Property

Public Property Let CheckURL(ByVal sCheckURL As String)
    msCheckURL = sCheckURL
End Property

Public Property Get LastUpdate() As Date
    Dim dtNow As Date
    dtNow = Int(Now)
    mdtLastUpdate = CDate(GetSetting(AppName, "Updates", "LastUpdate", "0"))
    If mdtLastUpdate = 0 Then
        'Never checked for an update, save today!
        SaveSetting AppName, "Updates", "LastUpdate", CStr(Int(dtNow))
    End If
    LastUpdate = mdtLastUpdate
End Property

Public Property Let LastUpdate(ByVal dtLastUpdate As Date)
    mdtLastUpdate = dtLastUpdate
    SaveSetting AppName, "Updates", "LastUpdate", CStr(Int(mdtLastUpdate))
End Property

Public Property Get AppName() As String
    AppName = msAppName
End Property

Public Property Let AppName(ByVal sAppName As String)
    msAppName = sAppName
End Property

Public Property Get Manual() As Boolean
    Manual = mbManual
End Property

Public Property Let Manual(ByVal bManual As Boolean)
    mbManual = bManual
End Property

In een normale module wordt een instantie van bovenstaande klasse gemaakt, haar initiele waarden worden ingesteld en het updated kan beginnen. Zie het commentaar in de code voor uitleg.

Option Explicit

Dim mcUpdate As clsUpdate

Public Declare Function InternetGetConnectedState _
                         Lib "wininet.dll" (lpdwFlags As Long, _
                                            ByVal dwReserved As Long) As Boolean

Function IsConnected() As Boolean
    Dim Stat As Long
    IsConnected = (InternetGetConnectedState(Stat, 0&) <> 0)
End Function

Sub AutoUpdate()
    CheckAndUpdate False
End Sub

Sub ManualUpdate()
    On Error Resume Next
    Application.OnTime Now, "CheckAndUpdate"
End Sub

Public Sub CheckAndUpdate(Optional bManual As Boolean = True)
    Set mcUpdate = New clsUpdate
    If bManual Then
        Application.Cursor = xlWait
    End If
    With mcUpdate
        'Set intial values of class
        'Current build
        .Build = 0
        'Name of this app, probably a global variable, such as GSAPPNAME
        .AppName = "UpdateAnAddin"
        'Get rid of possible old backup copy
        .RemoveOldCopy
        'URL which contains build # of new version
        .CheckURL = "https://jkp-ads.com/downloads/UpdateAnAddinBuild.htm"
        'Started check automatically or manually?
        .Manual = bManual
        'Check once a week
        If (Now - .LastUpdate >= 7) Or bManual Then
            .PlaceBuildQT bManual
        End If
    End With
TidyUp:
    On Error GoTo 0
    Exit Sub
End Sub

Download een Demo

Download de demo file hier: Update An addin

Vragen, suggesties en opmerkingen

Al het commentaar over deze pagina:

Commentaar van: Siebe Bosch (11-11-2010 06:37:14) deeplink naar dit commentaar

Hallo,

Hartstikke mooi, die invoegtoepassingen, maar ik vraag me een ding af: hoe krijg ik Excel zo ver dat hij m'n klassemodules in de invoegtoepassing onthoudt? Als ik een werkblad maak met daarin 1 gewone module en 2 klassemodules, en ik sla die set op als invoegtoepassing, dan onthoudt hij daarin alleen de module. De klassemodules zijn verdwenen.

Alvast bedankt voor uw reactie
Siebe Bosch

Commentaar van: Jan Karel Pieterse (11-11-2010 08:40:05) deeplink naar dit commentaar

Hoi Siebe,

Dat is hoogst ongebruikelijk. Normaal gesproken wordt OF het hele VBAProject opgeslagen met het bestand, OF helemaal geen VBAProject. Er tussenin heb ik nog nooit meegemaakt.

Commentaar van: Siebe Bosch (11-11-2010 09:02:28) deeplink naar dit commentaar

Hoi Jan Karel,

Misschien goed om even uiteen te zetten wat ik precies heb gedaan. Ik werk trouwens met office 2007

- Ik heb een nieuw Excel-bestand aangemaakt
- Een bestaande module (.bas) geïmporteerd. Hierin zitten wat modules en subroutines die ik regelmatig gebruik.
- Een tweetal klassemodules (.cls) geïmporteerd

Het excel-werkblad opgeslagen als invoegtoepassing (.xlam)

Vervolgens sluit ik het project af en maak een nieuw project aan. Daarbij zorg in de instellingen dat de zojuist opgeslagen invoegtoepassing aangevinkt is in de instellingen voor invoegtoepassingen.

Als ik daarna naar VB ga, zou ik verwachten dat de twee klassemodulen ook beschikbaar zijn. Dit is echter niet het geval.

Hieronder een van de klassemodulen. Ik weet: geen technisch hoogstandje zo zonder constructors, maar hij functioneerde totnogtoe altijd goed. Maar goed, zoals gezegd onthoudt Excel het bestaan ervan blijkbaar niet.

VERSION 1.0 CLASS
BEGIN
MultiUse = -1 'True
END
Attribute VB_Name = "clsNetwork"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

Public RRCFConstructions As New Collection

Public Sub writeFiles(OutputDir As String)

Dim fnsob As Long, fntp As Long, fncp As Long, fncn As Long, fncr As Long, fnme As Long, fnst As Long, fnobi As Long

fnsob = FreeFile
Open OutputDir & "\network.sob" For Output As #fnsob
    Print #fnsob, "SOB1.0"
    Print #fnsob, Chr(34) & ".\network.tp" & Chr(34)
    Print #fnsob, Chr(34) & ".\network.cp" & Chr(34)
    Print #fnsob, Chr(34) & ".\network.cn" & Chr(34)
    Print #fnsob, Chr(34) & ".\network.cr" & Chr(34)
    Print #fnsob, Chr(34) & ".\network.me" & Chr(34)
    Print #fnsob, Chr(34) & ".\network.st" & Chr(34)
    Print #fnsob, Chr(34) & ".\network.obi" & Chr(34)
Close (fnsob)
End Sub

Commentaar van: Jan Karel Pieterse (11-11-2010 09:09:28) deeplink naar dit commentaar

Hoi Siebe,

Ik heb sterk het vermoeden dat je een andere xlam opent dan je opgeslagen hebt.

Commentaar van: Lammert van der Deen (2-12-2019 22:03:00) deeplink naar dit commentaar

Hoi Jan Karel,

Werkt dit nog?

Ik krijg een foutmelding in Excel 2019 64b

Gr,
Lammert

Commentaar van: Jan Karel Pieterse (3-12-2019 10:38:00) deeplink naar dit commentaar

Hoi Lammert,

Welke foutmelding krijg je precies?

Heeft u vragen, suggesties of opmerkingen? Gebruik dan dit formulier.

Mocht uw vraag niet direct relevant zijn voor deze pagina, maar een algemene Excel vraag betreffen, dan adviseer ik om deze hier te stellen: excelexperts.nl/forum/index.php.