gegevens reeds open

[uchhie]

Hallo allemaal,

Is het mogelijk om met een VBA code in excel aan te geven dat een excel bestand geopent moet worden en als bestand reeds open staat niet de vraag wordt gesteld op reeds geopende bestand opnieuw te openen. Ik kom alleen tot het openen van het bestand met de volgende code. hopelijk dat iemand mij hiermee verder kan helpen. Alvaste bedankt

Sub test()
    Workbooks.Open FileName:= _
        "c:test.xls"
End Sub

 

[Ginger]

Ooit een prima stukje code gevonden bij MS zelf...

' This function checks to see if a file is open or not. If the file is
' already open, it returns True. If the file is not open, it returns
' False. Otherwise, a run-time error occurs because there is
' some other problem accessing the file.
' WERKT OOK VOOR NETWERKBESTANDEN

' Bron: http://support.microsoft.com/default.aspx?scid=kb;en-us;213383

Function IsFileOpen(filename As String)
    Dim filenum As Integer, errnum As Integer

    On Error Resume Next   ' Turn error checking off.
    filenum = FreeFile()   ' Get a free file number.
    ' Attempt to open the file and lock it.
    Open filename For Input Lock Read As #filenum
    Close filenum          ' Close the file.
    errnum = Err           ' Save the error number that occurred.
    On Error GoTo 0        ' Turn error checking back on.

    ' Check to see which error occurred.
    Select Case errnum

        ' No error occurred.
        ' File is NOT already open by another user.
        Case 0
            IsFileOpen = False

'        Case 53
'            IsFileOpen = False
        
        
        ' Error number for "Permission Denied."
        ' File is already opened by another user.
        Case 70
            IsFileOpen = True

        ' Another error occurred.
        Case Else
            Error errnum
    End Select

End Function

Je kan deze functie bijvoorbeeld zo gebruiken...

    'controleer lokaal of op het netwerk of het verzamelbestand openstaat
    If IsFileOpen([naam van jouw te testen bestand]) = False Then
        If MsgBox("Het werkboek staat niet open!" & vbCrLf & _
                "Nu openen?", vbCritical + vbYesNo + vbDefaultButton2, "Fout!") = vbYes Then
            Workbooks.Open [naam van jouw te testen bestand]
        Else
            Exit Sub
        End If
    End If

Groet, Leo

 

[uchhie]

Ooit een prima stukje code gevonden bij MS zelf...

Bedankt voor het meedenken, de code werkt met het testbestandje.:d
Alleen als ik deze wil toepassen op het bestand waar ik deze code eigenlijk voor wil gebruiken, krijg ik nog steeds de melding om het reeds geopende bestand opnieuw te openen. Ik heb de volgende VBA code gebruikt

Sub Testen()
    If IsFileOpen("C:\test.xls") Then
        Windows("test.xls").Activate
    Else
        Workbooks.Open "C:\test.xls"
    End If
End Sub

Function IsFileOpen(filename As String)
    Dim filenum As Integer, errnum As Integer

    On Error Resume Next
    filenum = FreeFile()
   
    Open filename For Input Lock Read As #filenum
    Close filenum
    errnum = Err
    On Error GoTo 0

    Select Case errnum
        
        Case 0
         IsFileOpen = False

        Case 70
            IsFileOpen = True
  
        Case Else
            Error errnum
    End Select

End Function

Het eigenlijk bestand, die geopend moet worden of geactiveerd moet worden als deze al open staat, is 4 mb. Kan de grootte van het bestand invloed hebben op de code

 

[uchhie]

Het eigenlijk bestand, die geopend moet worden of geactiveerd moet worden als deze al open staat, is 4 mb. Kan de grootte van het bestand invloed hebben op de code

Ik heb het testbestand 5 mb gemaakt en dan werkt de code ook, de grootte van het bestand is blijkbaar niet het probleem
Het eigenlijk bestand, is een gedeelde bestand. Met het testbestand ook geprobeerd in gedeeld bestand. Het bestand wordt dan opnieuw geopend ipv geactiveerd als deze al open staat. Ga ik wijzigen in het testbestand, dan krijg ik wel de melding dat bestand reeds open staat en of deze opnieuw wil openen.

ik kan de oplossing nog niet vinden, hopelijk dat iemand mij hier verder op weg kan helpen. bvd

 

[uchhie]

Opgelost

ik kan de oplossing nog niet vinden, hopelijk dat iemand mij hier verder op weg kan helpen. bvd

Ik heb het volledig anders gedaan en de code werkt nu ook met gedeelde bestanden

Sub testen()
Dim wBook As Workbook

On Error Resume Next
Set wBook = Workbooks("test.xls")
    If wBook Is Nothing Then
    Workbooks.Open "C:\test.xls"
           
Set wBook = Nothing

On Error GoTo 0

Else
Windows("tes.txls").Activate
            
Set wBook = Nothing

On Error GoTo 0
End If

End Sub