Office: VAB-Überprüfen, ob schreibgeschützte Dateien in Benutzung

Guten Tag Zusammen,

ich habe sehr viele Stunden mit dem unten stehenden Code verbracht und aus Einzelteilen zusammengebastellt. Jetzt stehe ich am Ende auf dem Schlauch...

Dadruch dass, ich so vieles rumprobiert habe, habe ich vergessen wie ich angefangen hab...

nun zum Code: es gibt eine Masterdatei in einem Verzeichnis mit anderen Dateien. Diese Masterdatei mit Spalte der Dateinamen durchsucht den Verzeichnis mit vielen anderen Dateien und bei Findung dieser Datei, die in Spalte steht, übernimmt die entsprechenden Werte.
Da die Dateien für andere Benutzer auch zugänglich sind, möchte ich, dass die Masterdatei mir anzeigt, ob die jeweilige Datei zurzeit benutzt wird, wenn ja, dann "in Benutzung", sonst nichts.

Da es bei uns in der Firma, alleine durch neues File erstellen und als Makrodatei speichern manchmal schon bei dieser Prozedur, nach Schreibschutz gefragt wird, hatte ich deshalb viele unterschiedliche Lösungen ausprobiert, und weiß jetzt nicht, ob es an mir, oder an dem Schreibschutz, oder sonst was lag..

Mit isFile Open und Funktion hatte eine Fremdhilfe bekomen, allerdings weiß ich jetzt nicht, wie ich meine Workbooks wieder schließe, die ich um Werte zu übertragen aufmachen musste ... Mit einfacher Workbook.Close funktioniert nicht, bzw. hat es bei mir nicht geklappt und das Prog gibt immer einen Fehler, oder macht nur eine Datei auf, und das wars...

Ich würde gerne was dafür spendieren, falls mir jemand in PM schreibt und seine Daten gibt ...
Bin wirklich am verzweifeln und kann diesen Code nicht mehr sehen ...

Freundliche Grüße
Bello

Manche auskomenntierte Zeile, sind vorherige Versuche...
bei objExcel.Close scheitert es (fett)

Code:

Sub Makro()
   
    'Neues Excel Objekt     
    Dim objExcel As New Excel.Application
    'Sheet Objekt der jeweiligen Exceldatei
    Dim objSheet As Object
    'Hilfsvariablen
    Dim iRow As Long, j As Long
    Dim strDateipfad As String
    Dim strPfad As String
    Dim strDateiname As String
    Dim wb As Workbook

    'Pfad in welchem die Dateien der zu
    'kopierenden Zellen sich befinden auswählen
    strPfad = ThisWorkbook.Path & Application.PathSeparator
    'Schleife welche den Zelleninhalt aller aufgelisteten
    'Dateien in mehrere Zellen des Hauptprogramms schreibt

    For iRow = 4 To Cells(Rows.Count, 4).End(xlUp).Row
        'Überprüfen, ob in Spalte "Dateiname" ein solcher eingetragen ist.
        '(der Arbeitsvorgang wird fortgesetzt)
        If Cells(iRow, 2) = "" Then 'Wenn Zelle in Spalte B Leer dann Exit
            Exit Sub
        Else
            strDateiname = Cells(iRow, 2)
            strDateipfad = strPfad & strDateiname & ".xlsm" '
            'Überprüfen, ob die in der Tabelle angegebene Datei vorhanden ist.
            '(der Arbeitsvorgang wird fortgesetzt)
            If Dir(strDateipfad) = "" Then
            Else

'On Error Resume Next
                ' Erst anderen Zugriff prüfen vor dem Öffnen und Auslesen

                objExcel.Workbooks.Open strDateipfad
                Set objSheet = objExcel.Sheets("Schnittstelle")

                For j = 7 To 27
                    Cells(iRow, j) = objSheet.Cells(j + 19, 2)

                    'Cells(Durchsuchte Spalte der Namen, Spaltenindex) =
                    'objSheets.cells(Zeile,Spalte)
                    ' (7 to 27) / (26 to 46)
                Next j

                objExcel.Workbooks.Close

                If isFileOpen(strDateipfad) = True Then
                    Cells(iRow, 3) = "in Benutzung" ' oder anders reagieren
                    Else: Cells(iRow, 3) = ""
                End If

'            Set wb = Workbooks.Open(strDateipfad, True)
'           If wb.WriteReservedBy <> Application.UserName Then
'            wb.Close
'                End If

                End If
            End If
    Next iRow
End Sub

Sub keine_Verknuepfung()
    Dim nRow As Long
    For nRow = 4 To Cells(Rows.Count, 4).End(xlUp).Row
        If Cells(nRow, 7).Value = "" Then
            Cells(nRow, 3) = "keine Verknüpfung"
        End If
    Next nRow
End Sub

Function isFileOpen(sFullname As String) As Boolean
    Dim kn As Integer, errNum As Long

    On Error Resume Next
    kn = FreeFile
    Open sFullname For Input Lock Read As #kn
        errNum = Err.Number
    Close kn
    On Error GoTo 0

    Select Case errNum
        Case 0          ' nicht geöffnet
            isFileOpen = False
        Case 70         ' bereits geöffnet
            isFileOpen = True
        Case Else       ' anderer Fehler
            Error errNum
    End Select
End Function

Sub alleMakros()
    Makro
    keine_Verknuepfung
End Sub

 

Hallo,

nachfolgend der modifizierte VBA-Code - allerdings von mir nur auf syntaktische Richtigkeit getestet; ich konnte das Funktionieren des Codes nicht testen.

Code:

Sub Makro()
  
    'Hilfsvariablen
    Dim iRow As Long, j As Long
    Dim strDateipfad As String
    Dim strPfad As String
    Dim strDateiname As String
    Dim Wb As Workbook
    Dim Ws As Worksheet                       '<====  !!!

    'Pfad in welchem die Dateien der zu
    'kopierenden Zellen sich befinden auswählen
    strPfad = ThisWorkbook.Path & Application.PathSeparator
    'Schleife welche den Zelleninhalt aller aufgelisteten
    'Dateien in mehrere Zellen des Hauptprogramms schreibt

    For iRow = 4 To Cells(Rows.Count, 4).End(xlUp).Row
        'Überprüfen, ob in Spalte "Dateiname" ein solcher eingetragen ist.
        '(der Arbeitsvorgang wird fortgesetzt)
        If Cells(iRow, 2) = "" Then 'Wenn Zelle in Spalte B Leer dann Exit
            Exit Sub
        Else
            strDateiname = Cells(iRow, 2)
            strDateipfad = strPfad & strDateiname & ".xlsm"
            'Überprüfen, ob die in der Tabelle angegebene Datei vorhanden ist.
            '(der Arbeitsvorgang wird fortgesetzt)
            If Len(Dir(strDateipfad)) Then                                   '<====  !!!
              
                If isFileOpen(strDateipfad) Then                             '<====  !!!
                    Cells(iRow, 3) = "in Benutzung" ' oder anders reagieren
                    GoTo Nxt_File                   ' Überspringe das Öffnen der Arbeitsmappe
                Else
                    Cells(iRow, 3) = ""
                End If
              
                Set Wb = Application.Workbooks.Open(Filename:=strDateipfad)  '<====  !!!   Quelldatei-Arbeitsmappe
                Set Ws = Wb.Worksheets("Schnittstelle")                      '<====  !!!   Arbeitsblatt in Quelldatei-Arb.Mappe

                For j = 7 To 27
                    Cells(iRow, j) = Ws.Cells(j + 19, 2)                     '<====  !!!

                    'Cells(Durchsuchte ZEILE der Namen, Spaltenindex) =
                    'objSheets.cells(Zeile,Spalte)
                    ' (iRow, 7 to 27) <== (26 to 46, 2)
                Next j

                Wb.Close                                                     '<====  !!!

            End If
        End If
Nxt_File:
    Next iRow
End Sub

Sub keine_Verknuepfung()
    Dim nRow As Long
    For nRow = 4 To Cells(Rows.Count, 4).End(xlUp).Row
        If Cells(nRow, 7).Value = "" Then
            Cells(nRow, 3) = "keine Verknüpfung"
        End If
    Next nRow
End Sub

Function isFileOpen(sFullname As String) As Boolean
    Dim kn As Integer, errNum As Long

    On Error Resume Next                 '<=== Ok!
    kn = FreeFile
    Open sFullname For Input Lock Read As #kn
        errNum = Err.Number              '<=== Ok!
    Close #kn
    On Error GoTo 0                      '<=== Ok!

    Select Case errNum
        Case 0          ' nicht geöffnet
            isFileOpen = False
'       Case 70         ' bereits geöffnet                                            '(????)
        Case 55, 70     ' bereits geöffnet(55), Zugriff/Berechtigung verweigert(70)   '<=== !!
            isFileOpen = True
        Case Else       ' anderer Fehler
            Error errNum
    End Select
End Function

Sub alleMakros()
    Makro
    keine_Verknuepfung
End Sub
'
'https://docs.microsoft.com/de-de/office/vba/language/reference/user-interface-help/trappable-errors
'
'TRAPPABLE ERRORS can occur while an application is running.
'Some trappable errors can also occur during development or compile time.
'You can test and respond to trappable errors by using the On Error statement and the Err object.
'Unused error numbers in the range 1–1000 are reserved for future use by Visual Basic.
'
'Code Message
'----------------------------
'52 Bad file name or number
'53 File Not found
'54 Bad file mode
'55 File already open          <====
'57 Device I/O error
'58 File already exists
'59 Bad record length
'61 Disk Full
'62 Input past end of file
'63 Bad record number
'67 Too many files
'68 Device unavailable
'70 Permission denied          <====
'71 Disk Not Ready
'74 Can 't rename with different drive
'75 Path/File access error
'76 Path Not found

 

Danke Anton Exl! Es Funktioniert!
aber es fellt nur noch eine Kleinigkeit (fett), die ich selbst noch hinzugefügt habe, was aber jetzt nicht ganz funkz, das Programm denkt und denkt.... Es ist höchstwahrscheinlich mein Logikfehler bei vielen Next, was ich nicht sehe....wäre echt super, wenn hier jemand schaut...

ich wollte, dass mein Programm den Screibschutz aufhebt, bzw ein Makro SchreibshcutzAufheben ausführt.

ich habe es mit Application.Run versucht...
irgendwas ist Falsch...

hier der Code
Und frohe mich über Rückmeldung

Code:

Sub Makro()
 
    'Hilfsvariablen
    Dim iRow As Long, j As Long
    Dim strDateipfad As String
    Dim strPfad As String
    Dim strDateiname As String
    Dim Wb As Workbook
    Dim Ws As Worksheet                       '
Application.ScreenUpdating = False
    'Pfad in welchem die Dateien der zu
    'kopierenden Zellen sich befinden auswählen
    strPfad = ThisWorkbook.Path & Application.PathSeparator
    'Schleife welche den Zelleninhalt aller aufgelisteten
    'Dateien in mehrere Zellen des Hauptprogramms schreibt

    For iRow = 4 To Cells(Rows.Count, 4).End(xlUp).Row
        'Überprüfen, ob in Spalte "Dateiname" ein solcher eingetragen ist.
        '(der Arbeitsvorgang wird fortgesetzt)
        If Cells(iRow, 2) = "" Then 'Wenn Zelle in Spalte B Leer dann Exit
            Exit Sub
        Else
            strDateiname = Cells(iRow, 2)
            strDateipfad = strPfad & strDateiname & ".xlsm"
            'Überprüfen, ob die in der Tabelle angegebene Datei vorhanden ist.
            '(der Arbeitsvorgang wird fortgesetzt)
            If Len(Dir(strDateipfad)) Then                                   '

                If isFileOpen(strDateipfad) Then                             '
                    Cells(iRow, 3) = "nicht aktuell" ' oder anders reagieren?
                    GoTo Nxt_File                   ' Überspringe das Öffnen der Arbeitsmappe
                Else
                    Cells(iRow, 3) = "aktuell"
                End If

                Set Wb = Application.Workbooks.Open(Filename:=strDateipfad)    '<====  !!!   Quelldatei-Arbeitsmappe
                Set Ws = Wb.Worksheets("Schnittstelle")                      '<====  !!!   Arbeitsblatt in Quelldatei-Arb.Mappe

            For Each Workbook In Array(strDateipfad)

                For i = 1 To Sheets.Count
              
                       ActiveWorkbook.Sheets(i).Unprotect Password:="meinPassword"
                        ActiveWorkbook.Save
                      
                  For j = 7 To 27
                    Cells(iRow, j) = Ws.Cells(j + 19, 2)                     '

                    'Cells(Durchsuchte ZEILE der Namen, Spaltenindex) =
                    'objSheets.cells(Zeile,Spalte)
                    ' (iRow, 7 to 27) <== (26 to 46, 2)
                Next j
                Next
            Next

                Wb.Close saveChanges = False                                  '

            End If
        End If
Nxt_File:
    Next iRow
End Sub

Sub keine_Verknuepfung()
    Dim nRow As Long
    For nRow = 4 To Cells(Rows.Count, 4).End(xlUp).Row
        If Cells(nRow, 15).Value = "" Then
            Cells(nRow, 3) = "keine Verknüpfung"
        End If
    Next nRow
End Sub

Function isFileOpen(sFullname As String) As Boolean
    Dim kn As Integer, errNum As Long

    On Error Resume Next                 '
    kn = FreeFile
    Open sFullname For Input Lock Read As #kn
        errNum = Err.Number              '
    Close #kn
    On Error GoTo 0                      '

    Select Case errNum
        Case 0          ' nicht geöffnet
            isFileOpen = False
'       Case 70         ' bereits geöffnet                                            '
        Case 55, 70     ' bereits geöffnet(55), Zugriff/Berechtigung verweigert(70)   '
            isFileOpen = True
        Case Else       ' anderer Fehler
            Error errNum
    End Select
End Function

'Code Message
'----------------------------
'52 Bad file name or number
'53 File Not found
'54 Bad file mode
'55 File already open          <====
'57 Device I/O error
'58 File already exists
'59 Bad record length
'61 Disk Full
'62 Input past end of file
'63 Bad record number
'67 Too many files
'68 Device unavailable
'70 Permission denied          <====
'71 Disk Not Ready
'74 Can 't rename with different drive
'75 Path/File access error
'76 Path Not found

Sub alleMakros()
    Makro

 

Hallo,

das Programm dachte überhaupt nichts, denn es war syntaktisch falsch, und somit hat der Compiler es gar nicht kompiliert und erst recht nicht gestartet. Damit solche Probleme gar nicht auftreten, ist es wichtig, dass man in jedem VBA-Modul als erste Codezeile "Option Explicit" einfügt. Man kann das auch in den Editor-Optionen einstellen, was LEIDER Microsoft aus "naheliegenden" Gründen nicht macht.

Ich habe dir die offensichtlich falschen Zeilen als Kommentar deaktiviert bzw. abgeändert:

Code:

           ' For Each Workbook In Array(strDateipfad)                          '<== Was soll das bewirken?
           '......
           ' Next
           '.....
           Wb.Close SaveChanges:=False       '<== Doppelpunkt vor "=" darf hier NICHT entfallen!!
 '.....
Sub alleMakros()            'Was soll das bewirken, was nicht eh schon "SUB Makro" macht?
    Makro
End Sub                     '<=== !!! Darf auf keinen Fall entfallen!!

Darüber hinaus habe ich einige Stellen NICHT geändert, weil ich nicht wusste, was du damit exakt bezweckst:
For I = 1 To Worksheets.Count
Da vor "Worksheets" kein Workbook angegeben ist, werden hier die Worksheets des ActiveWorkbook genommen.
ActiveWorkbook.Save
Da diese Zeile innerhalb der vorgenannten "For I"-Schleife steht, wird die aktive Arbeitsmappe Count-mal gespeichert, obwohl eine einzige Speicherung nach Abschluss der I-Schleife auch ausreichen würde.
Cells(iRow, J) = Ws.Cells(J + 19, 2) '
Da vor dem ersten "Cells" kein Workbook/Worksheet angegeben ist, wird in "Cells(iRow, J)" stets das ActiveWorkbook bzw. das ActiveWorksheet genommen und somit diese Zellen auch wieder Count-mal überspeichert.

Nachfolgend der VBA-Code:

Code:

Option Explicit

Sub Makro()

    'Hilfsvariablen
    Dim iRow As Long, J As Long, I As Long
    Dim strDateipfad As String
    Dim strPfad As String
    Dim strDateiname As String
    Dim Wb As Workbook
    Dim Ws As Worksheet                       '
  
    Application.ScreenUpdating = False
    'Pfad in welchem die Dateien der zu
    'kopierenden Zellen sich befinden auswählen
    strPfad = ThisWorkbook.Path & Application.PathSeparator
    'Schleife welche den Zelleninhalt aller aufgelisteten
    'Dateien in mehrere Zellen des Hauptprogramms schreibt

    For iRow = 4 To Cells(Rows.Count, 4).End(xlUp).Row
        'Überprüfen, ob in Spalte "Dateiname" (Spalte B) ein solcher eingetragen ist.
        '(der Arbeitsvorgang wird fortgesetzt)
        If Cells(iRow, 2) = "" Then 'Wenn Zelle in Spalte B Leer dann Exit
            Exit Sub
        Else
            strDateiname = Cells(iRow, 2)
            strDateipfad = strPfad & strDateiname & ".xlsm"
            'Überprüfen, ob die in der Tabelle angegebene Datei vorhanden ist.
            '(der Arbeitsvorgang wird fortgesetzt)
            If Len(Dir(strDateipfad)) Then                                   '

                If isFileOpen(strDateipfad) Then                             '
                    Cells(iRow, 3) = "nicht aktuell" ' oder anders reagieren?
                    GoTo Nxt_File                    ' Überspringe das Öffnen der Arbeitsmappe
                Else
                    Cells(iRow, 3) = "aktuell"
                End If

                Set Wb = Application.Workbooks.Open(Filename:=strDateipfad)    '<====  !!!   Quelldatei-Arbeitsmappe
                Set Ws = Wb.Worksheets("Schnittstelle")                        '<====  !!!   Arbeitsblatt in Quelldatei-Arb.Mappe

           ' For Each Workbook In Array(strDateipfad)                          '<== Was soll das bewirken?

                For I = 1 To Worksheets.Count
            
                  ActiveWorkbook.Worksheets(I).Unprotect Password:="meinPassword"
                  ActiveWorkbook.Save
                    
                  For J = 7 To 27
                    Cells(iRow, J) = Ws.Cells(J + 19, 2)                     '

                    'Cells(Durchsuchte ZEILE der Namen, Spaltenindex) =
                    'objSheets.cells(Zeile,Spalte)
                    ' (iRow, 7 to 27) <== (26 to 46, 2)
                  Next J
                Next I
           ' Next

                Wb.Close SaveChanges:=False                                   '<=== !! Doppelpunkt vor "=" darf hier NICHT entfallen!!

            End If
        End If
Nxt_File:
    Next iRow
End Sub

Sub keine_Verknuepfung()
    Dim nRow As Long
    For nRow = 4 To Cells(Rows.Count, 4).End(xlUp).Row
        If Cells(nRow, 15).Value = "" Then
            Cells(nRow, 3) = "keine Verknüpfung"
        End If
    Next nRow
End Sub

Function isFileOpen(sFullname As String) As Boolean
    Dim kn As Integer, errNum As Long

    On Error Resume Next                 '
    kn = FreeFile
    Open sFullname For Input Lock Read As #kn
        errNum = Err.Number              '
    Close #kn
    On Error GoTo 0                      '

    Select Case errNum
        Case 0          ' nicht geöffnet
            isFileOpen = False
'       Case 70         ' bereits geöffnet                                            '
        Case 55, 70     ' bereits geöffnet(55), Zugriff/Berechtigung verweigert(70)   '
            isFileOpen = True
        Case Else       ' anderer Fehler
            Error errNum
    End Select
End Function

'Code Message
'----------------------------
'52 Bad file name or number
'53 File Not found
'54 Bad file mode
'55 File already open          <====
'57 Device I/O error
'58 File already exists
'59 Bad record length
'61 Disk Full
'62 Input past end of file
'63 Bad record number
'67 Too many files
'68 Device unavailable
'70 Permission denied          <====
'71 Disk Not Ready
'74 Can 't rename with different drive
'75 Path/File access error
'76 Path Not found

Sub alleMakros()            'Was soll das bewirken, was nicht eh schon "SUB Makro" macht?
    Makro
End Sub                     '<=== !!! Darf auf keinen Fall entfallen!!

 

Hallo,
Danke vielmals,

mit viel "Rumbasteln" funtioniert es nun endlich so, wie ich es wollte (Testphase)! :)
Der Code sieht zwar nicht so proffessionel aus, und man kann da bestimmt Einiges kürzen, ist aber irrelevant, da es funkt!!!!

Freundliche Grüße
Bello

P.S. Ein wirklich großes Dank an Anton Exl !!!
Ohne dich wäre es sicherlich nicht zu dem Code gekommen,
ich würde gerne mich bei dir bedanken, weiß aber nicht wie... ! Und in welcher Form kannst natürlich selbst entscheiden (Bier, Geld, Schokoriegel etc.? :))

hier der neue Code für alle, die es vlt. brauchen könnten...

Code:

Option Explicit
Sub Ubertragung()

    'Neues Excel Objekt
    'Dim objExcel As New Excel.Application
    'Sheet Objekt der jeweiligen Exceldatei
    Dim objSheet As Object
    Dim shZ As Worksheet
    'Hilfsvariablen
    Dim iRow As Long, j As Long, I As Long

    Dim strDateipfad As String
    Dim strPfad As String
    Dim strDateiname As String
    Dim Wb As Workbook, WbZ As Workbook

    Set WbZ = ThisWorkbook
    Set shZ = WbZ.Worksheets(1)  '<=== anpassen !!!! "1" Index 1 ist die erste Arbeitstabelle

    'Pfad in welchem die Dateien der zu
    'kopierenden Zellen sich befinden auswählen
    strPfad = ThisWorkbook.Path & Application.PathSeparator
    'Schleife welche den Zelleninhalt aller aufgelisteten
    'Dateien in mehrere Zellen des Hauptprogramms schreibt


    For iRow = 4 To Cells(Rows.Count, 4).End(xlUp).Row         'For iRow = 4 To shZ.Cells(WbZ.Rows.Count, 4).End(xlUp).Row
        'Überprüfen, ob in Spalte "Dateiname" ein solcher eingetragen ist.
        '(der Arbeitsvorgang wird fortgesetzt)
        
        If shZ.Cells(iRow, 2) = "" Then '= "" Then 'Wenn Zelle in Spalte B Leer dann Exit
            Exit Sub
        Else
            strDateiname = shZ.Cells(iRow, 2)
            strDateipfad = strPfad & strDateiname & ".xlsm" '
            'Überprüfen, ob die in der Tabelle angegebene Datei vorhanden ist.
            '(der Arbeitsvorgang wird fortgesetzt)
            If Len(Dir(strDateipfad)) Then
                If isFileOpen(strDateipfad) Then
                shZ.Cells(iRow, 3) = "nicht aktuell"
            Else
            Cells(iRow, 3) = "aktuell"
            

                Set Wb = Workbooks.Open(strDateipfad, ReadOnly:=True)
                Set objSheet = Wb.Sheets("Schnittstelle")
                
                  For I = 1 To Sheets.Count
                  ActiveWorkbook.Worksheets(I).Unprotect Password:="KKI"    'Schreibschutz aufheben

                For j = 7 To 27
                   shZ.Cells(iRow, j) = objSheet.Cells(j + 19, 2)
                Next j
                Next I

                Wb.Close saveChanges:=False

                Set Wb = Nothing: Set objSheet = Nothing
            End If
          End If
        End If
Nxt_File:
    Next iRow
Set WbZ = Nothing: Set shZ = Nothing

keineVerknuepfung

End Sub

Sub keineVerknuepfung()
    Dim nRow As Long
    For nRow = 4 To Cells(Rows.Count, 4).End(xlUp).Row
        If Cells(nRow, 15).Value = "" Then
            Cells(nRow, 3) = "keine Verknüpfung"
        End If
    Next nRow
End Sub

Sub Abgleich1()  

keineVerknuepfung
Ubertragung        

End Sub
Function isFileOpen(sFullname As String) As Boolean
    Dim kn As Integer, errNum As Long

    On Error Resume Next                 '
    kn = FreeFile
    Open sFullname For Input Lock Read As #kn
        errNum = Err.Number              '
    Close #kn
    On Error GoTo 0                      '

    Select Case errNum
        Case 0          ' nicht geöffnet
            isFileOpen = False
'       Case 70         ' bereits geöffnet                                            '
        Case 55, 70     ' bereits geöffnet(55), Zugriff/Berechtigung verweigert(70)   '
            isFileOpen = True
        Case Else       ' anderer Fehler
            Error errNum
    End Select
End Function

'Code Message
'----------------------------
'52 Bad file name or number
'53 File Not found
'54 Bad file mode
'55 File already open          <====
'57 Device I/O error
'58 File already exists
'59 Bad record length
'61 Disk Full
'62 Input past end of file
'63 Bad record number
'67 Too many files
'68 Device unavailable
'70 Permission denied          <====
'71 Disk Not Ready
'74 Can 't rename with different drive
'75 Path/File access error
'76 Path Not found