Zamykání a odemykání souborů

Postup:
Option Explicit

Public Enum eOpenType
   eOpenUpdate
   eOpenRead
   eOpenNone
End Enum

Public Type tUserDetails
   ID As Integer
   Name As String * 20
End Type


Function FileLock(sFilePathName As String, _
   Optional eUpdateFile As eOpenType = eOpenUpdate, _
   Optional lRecordLength As Long = -1, _
   Optional lRecordNumber As Long = -1, _
   Optional iFreeFile As Integer = 0) As Integer
 

   'Zamčení souboru
   On Error GoTo ErrFailed
   Select Case eUpdateFile
      Case eOpenUpdate
         iFreeFile = FreeFile
         If lRecordLength = -1 Then
           Open sFilePathName For Random Shared As iFreeFile
        Else
           Open sFilePathName For Random Shared As _
              iFreeFile Len = lRecordLength
        End If
     Case eOpenRead
        iFreeFile = FreeFile
        If lRecordLength = -1 Then
          Open sFilePathName For Random Shared As iFreeFile
        Else
          Open sFilePathName For Random Shared As _
          iFreeFile Len = lRecordLength
        End If
     Case eOpenNone
   End Select

   If lRecordNumber = -1 Then
      Lock #iFreeFile
   Else
      Lock #iFreeFile, lRecordNumber
   End If

   FileLock = iFreeFile

Exit Function

ErrFailed:
   Debug.Print "Chyba: " & Err.Description
   FileLock = -1

End Function


Function FileUnLock(ByRef iFileHandle As Integer, _
   Optional lRecordNumber As Long = -1, _
   Optional bCloseFile As Boolean = True) As Boolean

   'Odemknutí souboru
   On Error GoTo ErrFailed
   If iFileHandle Then
      If lRecordNumber = -1 Then
         Unlock iFileHandle%
      Else
         Unlock iFileHandle%, lRecordNumber
      End If
      If bCloseFile Then
         Close #iFileHandle
         iFileHandle = 0
      End If
      FileUnLock = True
   End If

Exit Function

ErrFailed:
   Debug.Print "Chyba: " & Err.Description
   FileUnLock = -1

End Function

Příklad použití:
Sub Test()

   Dim iFileHandle As Integer, lThisUser As Long
   Dim tUser As tUserDetails, sFileName As String

   sFileName = "C:\test.txt"
   If Dir$(sFileName) <> "" Then
     VBA.Kill sFileName
   End If
   iFileHandle = FileLock(sFileName, eOpenUpdate, Len(tUser))

   tUser.Name = "The Bozena"
   For lThisUser = 1 To 20
     tUser.ID = lThisUser
     Put #iFileHandle, lThisUser, tUser
   Next
   FileUnLock iFileHandle, , False
   MsgBox "Soubor ' " & sFileName & "' nyní obsahuje záznamy... ",_
      vbInformation

   'Zamčení věty 1, následně aktualizace
   Call FileLock(sFileName, eOpenNone, Len(tUser), 1, iFileHandle)
   MsgBox "Věta 1 souboru ' " & sFileName & "' je nyní uzamčena.",_
      vbInformation
   tUser.Name = "Bill Gates"
   tUser.ID = 1
   Put #iFileHandle, 1, tUser

   For lThisUser = 1 To 20
     tUser.ID = lThisUser
     Get #iFileHandle, lThisUser, tUser
     Debug.Print "Jméno/ID: " & Trim$(tUser.Name) & "/" & tUser.ID
   Next

   'Uvolnění první věty a odemknutí souboru
   FileUnLock iFileHandle, 1, True

End Sub

Zpět