Avatar billede lisette Praktikant
19. januar 2005 - 15:30 Der er 2 kommentarer og
1 løsning

Er excel-fil allerede åben og af hvilken bruger

Hej

Jeg har brug for at lave en makro, som kan undersøge om alle filerne i en mappe allerede er åbne - og hvis ja, af hvilken bruger.

Jeg har forsøgt at fremprovokere denne handling ved at åbne en fil, som jeg ved allerede er åben af en anden bruger. Men desværre åbner den bare filen som read-only i stedet.

Kan I hjælpe mig igang ??
Avatar billede bak Forsker
19. januar 2005 - 16:58 #1
Det kræver lidt kode som jeg har lånt her:
http://www.xcelfiles.com/IsFileOpenAPI.htm

I subben TestAPI ændrer du stFile til at være lig med dit filnavn og sti

Option Explicit
'===========================================
'http://www.xcelfiles.com/IsFileOpenAPI.htm
'===========================================

'// Note we use an Alias here as using the Actual
'// function name will not be accepted! ie underscore= "_lopen"
Private Declare Function lOpen _
    Lib "kernel32" _
    Alias "_lopen" ( _
        ByVal lpPathName As String, _
        ByVal iReadWrite As Long) _
As Long

Private Declare Function lClose _
    Lib "kernel32" _
    Alias "_lclose" ( _
    ByVal hFile As Long) _
As Long

'// Don't use these...here for Info only
Private Const OF_SHARE_COMPAT = &H0
Private Const OF_SHARE_DENY_NONE = &H40
Private Const OF_SHARE_DENY_READ = &H30
Private Const OF_SHARE_DENY_WRITE = &H20
'// Use the Constant below
'// OF_SHARE_EXCLUSIVE = &H10
'// OPENS the FILE in EXCLUSIVE mode,
'// denying other processes AND the current process both read and write
'// access to the file. If the file has been opened in any other mode for read or
'// write access _lopen fails. This is important as if you open the file in the
'// current process = Excel BUT loose its handle
'// then you CANNOT open it again in the SAME session!
Private Const OF_SHARE_EXCLUSIVE = &H10

Sub TestAPI()
Dim stFile As String
stFile = "c:\data.xls"
'// We can use this for ANY FILE not just Excel!
    If IsFileAlreadyOpen(stFile) Then
        MsgBox stFile & " is already Open" & _
            vbCrLf & "By " & LastUser(stFile), vbInformation, "File in Use"
    Else
        MsgBox "File is NOT open", vbInformation
    End If
End Sub


'If the Function succeeds, the return value is a File handle.
'If the Function fails, the return value is HFILE_ERROR = -1

Private Function IsFileAlreadyOpen(strFullPath_FileName As String) As Boolean
'// Ivan F Moala
'// http://www.xcelfiles.com
Dim hdlFile As Long
Dim lastErr As Long

hdlFile = -1

'// Open file for Read/Write and Exclusive Sharing.
hdlFile = lOpen(strFullPath_FileName, OF_SHARE_EXCLUSIVE)
'// If we can't open the file, get the last error.
If hdlFile = -1 Then
    lastErr = Err.LastDllError
Else
    '// Make sure we close the file on success!
    lClose (hdlFile)
End If

'// Check for sharing violation error.
IsFileAlreadyOpen = (hdlFile = -1) And (lastErr = 32)

End Function



Private Function LastUser(strPath As String) As String
'// Code by Helen from http://www.visualbasicforum.com/index.php?s=
'// This routine gets the Username of the File In Use
'// Credit goes to Helen for code & Mark for the idea
'// Insomniac for xl97 inStrRev
'// Amendment 25th June 2004 by IFM
'// : Name changes will show old setting
'// : you need to get the Len of the Name stored just before
'// : the double Padded Nullstrings
Dim strXl As String
Dim strFlag1 As String, strflag2 As String
Dim i As Integer, j As Integer
Dim hdlFile As Long
Dim lNameLen As Byte


strFlag1 = Chr(0) & Chr(0)
strflag2 = Chr(32) & Chr(32)

hdlFile = FreeFile
Open strPath For Binary As #hdlFile
    strXl = Space(LOF(hdlFile))
    Get 1, , strXl
Close #hdlFile

j = InStr(1, strXl, strflag2)

#If Not VBA6 Then
    '// Xl97
    For i = j - 1 To 1 Step -1
        If Mid(strXl, i, 1) = Chr(0) Then Exit For
    Next
    i = i + 1
#Else
    '// Xl2000+
    i = InStrRev(strXl, strFlag1, j) + Len(strFlag1)
#End If

'// IFM
lNameLen = Asc(Mid(strXl, i - 3, 1))
LastUser = Mid(strXl, i, lNameLen)

End Function
Avatar billede lisette Praktikant
20. januar 2005 - 09:54 #2
Perfekt - det virker !!

Jeg er imponeret. Vil du ligge et svar, så du kan få point?
Avatar billede bak Forsker
20. januar 2005 - 12:59 #3
ok lisette, det kommer så her :-)
Avatar billede Ny bruger Nybegynder

Din løsning...

Tilladte BB-code-tags: [b]fed[/b] [i]kursiv[/i] [u]understreget[/u] Web- og emailadresser omdannes automatisk til links. Der sættes "nofollow" på alle links.

Loading billede Opret Preview
Kategori
Excel kurser for alle niveauer og behov – find det kursus, der passer til dig

Log ind eller opret profil

Hov!

For at kunne deltage på Computerworld Eksperten skal du være logget ind.

Det er heldigvis nemt at oprette en bruger: Det tager to minutter og du kan vælge at bruge enten e-mail, Facebook eller Google som login.

Du kan også logge ind via nedenstående tjenester

IT-JOB