Dear Be-Exceller,
Saya mau cek apakah file di server dibuka oleh orang lain atau dibuka
dikomputer sendiri. File itu ada di server. Saya sudah bikin code nya tapi kok
gak bisa ya ? Mohon bimbingannya.
Ini code saya :
Public function sFileAdaAccess(fname) as Boolean
sFileAdaAccess = True
If IsFileOpen(fname) = True Then
Set wbbook = Workbooks(fname)
If Not wbbook.ReadOnly = True Then
MsgBox "Silahkan ditutup dulu File Master", vbExclamation,
"File master terbuka"
sFileAdaAccess = false
Exit Function
Else
sFileAdaAccess = True
End If
Set wbbook = Nothing
'End If
Public Function IsFileOpen(filename As String) As Boolean
Dim filenum As Integer
Dim errnum As Integer
On Error Resume Next ' Turn error checking off.
'''''''''''''''''''''''''''''''''''''''''''
' If we were passed in an empty string,
' there is no file to test so return FALSE.
'''''''''''''''''''''''''''''''''''''''''''
If filename = vbNullString Then
IsFileOpen = False
Exit Function
End If
'''''''''''''''''''''''''''''''
' If the file doesn't exist,
' it isn't open so get out now.
'''''''''''''''''''''''''''''''
If Dir(filename) = vbNullString Then
IsFileOpen = False
Exit Function
End If
''''''''''''''''''''''''''
' Get a free file number.
''''''''''''''''''''''''''
filenum = FreeFile()
'''''''''''''''''''''''''''
' Attempt to open the file
' and lock it.
'''''''''''''''''''''''''''
Err.Clear
Open filename For Input Lock Read As #filenum
''''''''''''''''''''''''''''''''''''''
' Save the error number that occurred.
''''''''''''''''''''''''''''''''''''''
errnum = Err.Number
On Error GoTo 0 ' Turn error checking back on.
Close #filenum ' Close the file.
''''''''''''''''''''''''''''''''''''
' Check to see which error occurred.
''''''''''''''''''''''''''''''''''''
Select Case errnum
Case 0
'''''''''''''''''''''''''''''''''''''''''''
' No error occurred.
' File is NOT already open by another user.
'''''''''''''''''''''''''''''''''''''''''''
IsFileOpen = False
Case 70
'''''''''''''''''''''''''''''''''''''''''''
' Error number for "Permission Denied."
' File is already opened by another user.
'''''''''''''''''''''''''''''''''''''''''''
IsFileOpen = True
'''''''''''''''''''''''''''''''''''''''''''
' Another error occurred. Assume the file
' cannot be accessed.
'''''''''''''''''''''''''''''''''''''''''''
Case Else
IsFileOpen = True
End Select
End Function
Kenapa tidak berhasil ? Mohon bimbingannya.
Terima kasih.
Tio
