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

Helfe beim Thema VAB-Überprüfen, ob schreibgeschützte Dateien in Benutzung in Microsoft Excel Hilfe um das Problem gemeinsam zu lösen; Guten Tag Zusammen, ich habe sehr viele Stunden mit dem unten stehenden Code verbracht und aus Einzelteilen zusammengebastellt. Jetzt stehe ich am... Dieses Thema im Forum "Microsoft Excel Hilfe" wurde erstellt von Bello, 1. April 2021.

  1. Bello Neuer User

    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
     
    Bello, 1. April 2021
    #1
  2. Exl121150 Erfahrener User
    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
    
    
     
    Exl121150, 3. April 2021
    #2
    1 Person gefällt das.
  3. Bello Neuer User
    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
     
    Bello, 7. April 2021
    #3
  4. Exl121150 Erfahrener User

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

    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!!
    
    
     
    Exl121150, 9. April 2021
    #4
  5. Bello Neuer User
    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
     
Thema:

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

Die Seite wird geladen...
  1. VAB-Überprüfen, ob schreibgeschützte Dateien in Benutzung - Similar Threads - VAB Überprüfen schreibgeschützte

  2. Outlook 2016

    in Microsoft Outlook Hilfe
    Outlook 2016: Ich benutze Windows 10 und Microsoft Office Home and Business 2016 mit Word 2016, Excel 2016, PowerPoint 2016, OneNote 2016 und Outlook 2016. 64-Bit-Version Ich möchte in Outlook eingehende...
  3. Zellen überprüfen und Zusammenfügen

    in Microsoft Excel Hilfe
    Zellen überprüfen und Zusammenfügen: Hallo zusammen, ich brauche Eure Hilfe. Ich habe euch die Datei "test1" beigefügt. In der Spalte A werden die Rechnungsnummer aufgezeigt. Es werden bestimmte Maschinen und das dazugehörige...
  4. VBA: Wenn der Wert >2 dann soll eine E-Mail versendet werden. Überprüfung von ca. 100 Zeilen.

    in Microsoft Excel Hilfe
    VBA: Wenn der Wert >2 dann soll eine E-Mail versendet werden. Überprüfung von ca. 100 Zeilen.: Hallo Zusammen, ich habe das Problem das wir in unserem Unternehmen eine Bestandsliste unserer Toner in Excel führen. Aktuell bin verusche ich diese übersichtlicher und mit einen Upgrades zu...
  5. Suche VAB Zeilen ausblenden die nicht suche entsprechen

    in Microsoft Excel Hilfe
    Suche VAB Zeilen ausblenden die nicht suche entsprechen: Guten Abend zusammen, ich habe eine Tabelle in der in Spalte B Kundennummern stehen, in Spalte C Kundennamen(siehe Anhang). ich möchte jetzt eine Makro das wenn ich in Zelle C5 eine...
  6. Suche VAB Zeilen ausblenden die nicht suche entsprechen

    in Microsoft Excel Hilfe
    Suche VAB Zeilen ausblenden die nicht suche entsprechen: Suche VBA Zeilen ausblenden die nicht suche entsprechen Guten Abend zusammen, ich habe eine Tabelle in der in Spalte B Kundennummern stehen, in Spalte C Kundennamen(siehe Anhang). ich...
  7. VAB Problem

    in Microsoft Excel Hilfe
    VAB Problem: Hallo Leute, ich habe mir jetzt eine kunden Tabelle gebastelt, habe jetzt das Problem ...... 1) Menü auf Kunden bei Name ma Eintippen und auf suchen gehen so und jetzt das Problem wenn ich den...
  8. Werte übernehmen mit Zeitspiegel Verschiebung per VAB-Formel

    in Microsoft Excel Hilfe
    Werte übernehmen mit Zeitspiegel Verschiebung per VAB-Formel: Hallo verehrte Damen und Herren, bin bei meinem Problem an meine Grenzen gestoßen.Hoffe es kann mir hier geholfen werden. IST zustand: Siehe auch angehängte Datei Tabellenblatt "Daten...
  1. Diese Seite verwendet Cookies, um Inhalte zu personalisieren, diese deiner Erfahrung anzupassen und dich nach der Registrierung angemeldet zu halten.
    Auf dieser Website werden Cookies für die Zugriffsanalyse und Anzeigenmessung verwendet.
    Wenn du dich weiterhin auf dieser Seite aufhältst, akzeptierst du unseren Einsatz von Cookies.
    Information ausblenden