Laufzeitfehler 1004 bei Freigabe von Excel Datei

Private Sub Worksheet_Change(ByVal Target As Excel.Range) '//Makro zur Verwaltung der  _
Ordneranlage und
'//Angabe konstanter Zeilen
intdateispalte = 20
intnummerspalte = 4
interstemaengelzeile = 9
'//Filesystemvariablen definieren
Set fs1 = CreateObject("Scripting.FileSystemObject")
Set fs = CreateObject("Scripting.FileSystemObject")
Set fs2 = CreateObject("Scripting.FileSystemObject")
'//Gucken ob eine Zelle in Spalte A markiert ist
If Target.Column = "4" And Target.Row >= interstemaengelzeile Then
If a = 1 Then
a = 0
Exit Sub
End If
Zeile = Target.Row        'Zeile Auslesen
Inhalt = Target.Value 'Inhalt der Markierten Zelle auslesen
produkt = ThisWorkbook.Worksheets("Mängelpunkte").Cells(4, 6).Value
intlaenge = Len(produkt)
'// Hier tritt ein Fehler auf, wenn manuell eine Zeile gelöscht wird. Dieser wird hier  _
abgefangen und nur kurz ausgegeben.
On Error Resume Next
inhaltkurz = Left(Inhalt, intlaenge)
If Err.Number  0 Then
MsgBox (Err.Description & "!    -Diese Fehlermeldung soll Sie darauf hinweisen, dass durch  _
gleichzeitige Bearbeitung mehrerer Zellen, in der Spalte der laufenden Nummer, keine Ordner angelegt oder gelöscht werden können. Bitte führen Sie dies später separat durch."), vbExclamation
Exit Sub
End If
On Error GoTo 0
test_inhalt = ThisWorkbook.Worksheets("Mängelpunkte").Cells(Zeile, intdateispalte).Value
'//Überprüfen ob das Produktkürzel vorangestellt wurde
If inhaltkurz = produkt Then
'//Überprüfung ob in der Spalte des Hyperlinks was steht, wenn dort was stehtt, wird davon  _
ausgegangen , dass bereits eine laufende Nummer vergeben wurde
If test_inhalt = "" Then
antwort = MsgBox("Soll ein Ordner zum Abspeichern von Bildern und weiteren Daten  _
angelegt werden?", vbYesNo + vbQuestion)
If antwort = vbYes Then
'//Überprüfen ob schon ein Ordner mit diesem ,neuen, Namen existiert
If fs1.folderexists(ThisWorkbook.Path & "\Ordner_fuer_Hintergrundinformationen\" &  _
Inhalt) Then
MsgBox (" Ein Ordner mit diesem Namen existiert bereits. Bitte überprüfen Sie die  _
lfd. Nummer, oder ob sich im Speicherpfad fehlerhafter Weise ein Ordner mit diesem Namen befindet"), vbQuestion
a = 1
ThisWorkbook.Worksheets("Mängelpunkte").Cells(Zeile, intnummerspalte).Value =  _
test_inhalt
Else
'//den neuen ordner anlegen in das Verzeichnis des Excels plus Namen "Inhalt"
Set ordner = fs.CreateFolder(ThisWorkbook.Path & "\ _
Ordner_fuer_Hintergrundinformationen\" & Inhalt)
'//Den Hyperlink erstellen
ThisWorkbook.Worksheets("Mängelpunkte").Hyperlinks.Add Anchor:=ThisWorkbook. _
Worksheets("Mängelpunkte").Cells(Zeile, intdateispalte), Address:=(ThisWorkbook.Path & "\Ordner_fuer_Hintergrundinformationen\" & Inhalt), TextToDisplay:=Inhalt
MsgBox ("Es wurde ein neuer Ordner mit dem Namen: " & Inhalt & " angelegt"),  _
vbInformation
End If
End If
Else
rueckgabe = MsgBox("Sie haben die Laufende Nummer geändert, obwohl bereits ein Hyperlink  _
besteht. Möchten Sie wirklich den Link und den Ordner samt Inhalt, löschen? -In dem Ordner gespeicherte Daten sind dann verloren!", vbYesNo + vbCritical + vbDefaultButton2)
'//Abfragen ob der bereits bestehende Ordner gelöscht werden soll
If rueckgabe = vbYes Then
If fs1.folderexists(ThisWorkbook.Path & "\Ordner_fuer_Hintergrundinformationen\" &  _
test_inhalt) Then
fs2.deletefolder (ThisWorkbook.Path & "\Ordner_fuer_Hintergrundinformationen\" &  _
test_inhalt)
End If
antwort = MsgBox("Soll ein Ordner zum Abspeichern von Bildern und weiteren Daten  _
angelegt werden?", vbYesNo + vbQuestion)
If antwort = vbYes Then
If fs1.folderexists(ThisWorkbook.Path & "\Ordner_fuer_Hintergrundinformationen\" &  _
Inhalt) Then
MsgBox (" Ein neuer Ordner mit diesem Namen existiert bereits. Bitte überprüfen  _
Sie die lfd. Nummer, oder ob sich im Speicherpfad fehlerhafter Weise ein Ordner mit diesem Namen befindet"), vbQuestion
a = 1
ThisWorkbook.Worksheets("Mängelpunkte").Cells(Zeile, intdateispalte).Value = ""
Else
'//den neuen ordner anlegen in das Verzeichnis des Excels plus Namen "Inhalt"
Set ordner = fs.CreateFolder(ThisWorkbook.Path & "\ _
Ordner_fuer_Hintergrundinformationen\" & Inhalt)
'//Den Hyperlink erstellen
ThisWorkbook.Worksheets("Mängelpunkte").Hyperlinks.Add Anchor:=ThisWorkbook. _
Worksheets("Mängelpunkte").Cells(Zeile, intdateispalte), Address:=(ThisWorkbook.Path & "\Ordner_fuer_Hintergrundinformationen\" & Inhalt), TextToDisplay:=Inhalt
MsgBox ("Es wurde ein neuer Ordner mit dem Namen: " & Inhalt & " angelegt"),  _
vbInformation
End If
Else
ThisWorkbook.Worksheets("Mängelpunkte").Cells(Zeile, intdateispalte).Value = ""
End If
Else
a = 1
ThisWorkbook.Worksheets("Mängelpunkte").Cells(Zeile, intnummerspalte).Value =  _
test_inhalt
End If
End If
Else
MsgBox ("Bitte denken Sie daran das Produktkürzel voran zu stellen"), vbExclamation
a = 1
ThisWorkbook.Worksheets("Mängelpunkte").Cells(Zeile, intnummerspalte).Value = test_inhalt
End If
End If
End Sub