Hvis Excel filen er åben skal filen ikke åbnes igen

Kan du ikke bruge den her (som jeg har hugget fra Microsoft):

Function FileLocked(strFileName As String) As Boolean
      On Error Resume Next

      ' If the file is already opened by another process,
      ' and the specified type of access is not allowed,
      ' the Open operation fails and an error occurs.
      Open strFileName For Binary Access Read Write Lock Read Write As #1
      Close #1

      ' If an error occurs, the document is currently open.
      If Err.Number <> 0 Then
        ' Display the error number and description.
        MsgBox "Error #" & Str(Err.Number) & " - " & Err.Description
        FileLocked = True
        Err.Clear
      End If
  End Function

I din funktion kan du så skrive

If Not FileLocked(strFileName) Then

... alt det der kode du så har

Else
  MsgBox "Filen bruges af en anden"
End if


Det er bar en forslaw!

I øvrigt kan du finde en lidt anderledes version af samme program her

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

TUSIND TAK sjap
Det virker nu, dog mangler jeg at få det til at virke fra relativ mappe

Sub Export()
    Dim Tekst As String, Titel As String, Svar As Integer
        Tekst = "        Vil du Exportere Data"
        Titel = "      Bekræft Export"
        Svar = MsgBox(Tekst, vbYesNo, Titel)
        If Svar = vbYes Then
        Else
        If Not DBoksOK Then GoTo Slut
    End If
    '**************************
    ChDir "D:\"
    If IsFileOpen("D:\Data.Fag") Then ''''''''''''''''''HVORDAN OMSÆTTER MAN STIEN TIL RELATIV (SE RELATIV)
        MsgBox "Filen er åben af anden bruger"
       
    Else
       
        ChDir "D:\" ''''''''''''''''''HVORDAN OMSÆTTER MAN STIEN TIL RELATIV (SE RELATIV)
        Workbooks.Open "D:\Data.FAG" ''''''''''''''''''HVORDAN OMSÆTTER MAN STIEN TIL RELATIV (SE RELATIV)
   
    'sti = ThisWorkbook.Path''''''''''''''''''(RELATIV)
    'Workbooks.Open sti & "\Data.FAG"'''''''''(RELATIV)
    Range("A2").Select
    Do While ActiveCell <> ""
    ActiveCell.Offset(1, 0).Select
    Loop
    ActiveSheet.Unprotect
    ActiveWindow.ActivateNext
    Sheets("Afgraens").Select
    Range("A2").Select
    Do Until IsEmpty(Cells(X + 1, 2).Value)
    X = X + 1
    Loop
    Range(Cells(2, 45), Cells(X, 1)).Select
    Selection.Copy
    Windows("Data.FAG").Activate
    Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    Range("A2").Select
    ActiveSheet.Protect
    ActiveWorkbook.Save
    ActiveWindow.Close
    ActiveSheet.Unprotect
    Selection.ClearContents
    Range("A2").Select
    ActiveSheet.Protect
    Sheets("Kartotek").Select
 
Slut:
End If
End Sub

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

        ' 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

Hvad mener du med "relativ"? Jeg forstår det ikke helt.

Måske er det, det her du mangler?

OpenFilnavn = ThisWorkbook.Path & "\Data.FAG"
If IsFileOpen(OpenFilnavn) Then
...

Så kan du bruge variablen OpenFilnavn alle steder, hvor du skal bruge navnet, på den fil du forsøger at åbne.

Jeg kan ikke få det til at virke. Jeg prøver at se på det senere, men mange tak

OK.

Er du sikker på at Data.fag ligger i samme mappe som det regneark, hvor du kører makroen fra?

Ja Data.FAG ligger i samme mappe Her er hele koden jeg har prøvet med!

Sub Export()
    Dim Tekst As String, Titel As String, Svar As Integer
        Tekst = "        Vil du Exportere Data"
        Titel = "      Bekræft Export"
        Svar = MsgBox(Tekst, vbYesNo, Titel)
        If Svar = vbYes Then
        Else
        If Not DBoksOK Then GoTo Slut
    End If
   
    OpenFilnavn = ThisWorkbook.Path & "\Data.FAG"
    If IsFileOpen(OpenFilnavn) Then '************************ Den vil ikke akseptere den her linje Jeg køre med Excel 95 men jeg har også prøvet Excel 2003
        MsgBox "Filen er åben af anden bruger"
       
    Else
       
        'ChDir "D:\"
        'Workbooks.Open "D:\Data.FAG"
   
    sti = ThisWorkbook.Path
    OpenFilnavn = ThisWorkbook.Path & "\Data.FAG"
    Workbooks.Open sti & "\Data.FAG"
    Range("A2").Select
    Do While ActiveCell <> ""
    ActiveCell.Offset(1, 0).Select
    Loop
    ActiveSheet.Unprotect
    ActiveWindow.ActivateNext
    Sheets("Afgraens").Select
    Range("A2").Select
    Do Until IsEmpty(Cells(X + 1, 2).Value)
    X = X + 1
    Loop
    Range(Cells(2, 45), Cells(X, 1)).Select
    Selection.Copy
    Windows("Data.FAG").Activate
    Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    Range("A2").Select
    ActiveSheet.Protect
    ActiveWorkbook.Save
    ActiveWindow.Close
    ActiveSheet.Unprotect
    Selection.ClearContents
    Range("A2").Select
    ActiveSheet.Protect
    Sheets("Kartotek").Select
 
Slut:
End If
End Sub

'***********************************************
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

        ' 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

Hvilken fejl kommer den med?

Jeg ved ikke om det betyder noget, men prøv lige at præcisere følgende i IsFileOpen funktionen:

Function IsFileOpen(filename As String) As Boolean

Undskyld jeg ikke har svaret før, jeg kunne ikke få det til at virke (fra relativ Mappe) jeg stod og skulle bruge det, så jeg har bare brugt det første svar du sendte og det virker jo også godt, men endnu engang tak.