Tjek om fil er åben på netværk

Ups glemte lige
Koden skal virke med Excel 2003(evt.også Excel 2007)
Lars

prøv at lege med dette, er ikke testet

Public Sub TjekFil()
Dim Fil As String

  Fil = "C:\Mappe1.xls"
If GetAttr(Fil) = vbReadOnly Then
MsgBox "Filen " & Fil & " er skrivebeskyttet"
Else
MsgBox "Filen " & Fil & " er IKKE skrivebeskyttet"
End If


End Sub

Denne kode virker hos mig.

Option Explicit
Sub Sample()
    Dim Ret
    Ret = IsWorkBookOpen("Sti og navn indsættes her")
    If Ret = True Then
        MsgBox "Filen er i brug"
    Else
    MsgBox ("Filen åbnes")
Application.Workbooks.Open ("Sti og navn indsættes her")
    End If
End Sub
Function IsWorkBookOpen(FileName As String)
    Dim ff As Long, ErrNo As Long
    On Error Resume Next
    ff = FreeFile()
    Open FileName For Input Lock Read As #ff
    Close ff
    ErrNo = Err
    On Error GoTo 0
    Select Case ErrNo
    Case 0:    IsWorkBookOpen = False
    Case 70:  IsWorkBookOpen = True
    Case Else: Error ErrNo
    End Select
End Function

Hej igen
Tak for imput,har prøvet din kode Jens den virker.
Mit problem:
hvis jeg åbner min fil, lukker den uden at ha' indtastet nyt
Dialogboks:
skal ændringerne i D:\Dokumenter\Test.xls'gemmes

Hvordan finder jeg ud af hvilke ændringer der er fortaget?
Thisworkbook:

Option Explicit
  Sub Sample()
  Dim Ret
  Ret = IsWorkBookOpen("D:\Dokumenter\Test.xls")
  If Ret = True Then
  MsgBox "Filen er i brug"
  Else
  Application.Workbooks.Open ("D:\Dokumenter\Test.xls")
  End If
  End Sub
Function IsWorkBookOpen(FileName As String)
  Dim ff As Long, ErrNo As Long
  On Error Resume Next
  ff = FreeFile()
  Open FileName For Input Lock Read As #ff
  Close ff
  ErrNo = Err
  On Error GoTo 0
  Select Case ErrNo
  Case 0:    IsWorkBookOpen = False
  Case 70:  IsWorkBookOpen = True
  Case Else: Error ErrNo
  End Select
  End Function

Private Sub Workbook_Open()
  Application.ScreenUpdating = False
  Range("D301").Select
  Sheets("ark1").Select
  ActiveWindow.ScrollRow = 1
  ActiveWindow.ScrollColumn = 1
callsub: workbookopen
  Application.ScreenUpdating = True
  End Sub

Module1
Sub workbookopen()
Password = "xxx"
    ActiveWorkbook.Unprotect Password
    Password = "xxx"
    ActiveWorkbook.Protect Password, Structure:=True, Windows:=True
End Sub

Hvis jeg sletter thisworkbook koder får jeg stadig
skal ændringerne i D:\Dokumenter\Test.xls'gemmes
Hvordan finder jeg ud af hvilke ændringer der er fortaget?

Lars Fatsvag

Hej igen
har fundet svaret(ændringer)
http://support.microsoft.com/kb/274500/en-us

Er det muligt at tilføje dette til koden fra Jens:
IsWorkBookOpen = False Then
Range("CE4") = 1
IsWorkBookOpen = true Then
Range("CE4") = 2
Vil bruge det til at lave betingetformateringer der tydeligt viser om arket er skrivebeskyttet.
mvh
Lars

Idet jeg får ud fra at der skal skrives i det oprindelige dokument og ikke i det der åbnes, kommer makroen f.eks. til at se sådan ud:

Option Explicit
Sub Sample()
    Dim Ret
    Ret = IsWorkBookOpen("D:\dokumenter\test.xls")
    If Ret = True Then
    Range("CE4") = 2
        MsgBox "Filen er i brug"
       
    Else
    Range("CE4") = 1
    MsgBox ("Filen åbnes")
Application.Workbooks.Open ("D:\dokumenter\test.xls")
    End If
End Sub
Function IsWorkBookOpen(FileName As String)
    Dim ff As Long, ErrNo As Long
    On Error Resume Next
    ff = FreeFile()
    Open FileName For Input Lock Read As #ff
    Close ff
    ErrNo = Err
    On Error GoTo 0
    Select Case ErrNo
    Case 0:    IsWorkBookOpen = False
    Case 70:  IsWorkBookOpen = True
    Case Else: Error ErrNo
    End Select
End Function

Hej igen
Jeg fatter ikke koden...
Hvis jeg flytter filen fra den angivne sti("D:\dokumenter\test.xls")
så åbner filen?

åbner jeg filen test.xls
manuelt kører makroen:Thisworkbook.sample
MsgBox "File not found"

Hvor skal koderne placeres?
ThisWoorkbook(her står mine,det er vel fejlen)
module
andet
MsgBox "File not found",skal vel komme når jeg åbner filen
(den er jo ikke på den angivne sti.)
mvh.
Lars

Hvis du flytter filen fra den angivne sti virker makroen ikke. Du skal lægge makroen under ThisWorkbook.
Jeg tror du blander flere forskellige makroer sammen. Der er intet i min makro der skriver en MsgBox med "File not found"

Hej
Bedre sent end aldrig, excel giver automatisk besked hvis filen er åben(uden VBA kode).
smid svar for point
Lars

du får et svar