25.01.2025, 13:52
Hallo,
dieser Code funktioniert einwandfrei bei der Arbeit mit einem RDP-Server und der gleichen Excel-2016-Version.
In Spalte D steht eine Produktionsnummer, die bereinigt wird. Anschließend wird die Datei nummer.xlsm geöffnet,
der Wert aus Zelle C7 des Tabellenblatts "Eingabe" kopiert und in Spalte G eingefügt, dann die nächste Datei.
Ich wollte den Code zu Hause ausprobieren, habe die gleiche Ordnerstruktur eingerichtet und die Pfade entsprechend angepasst. Alle Skripte funktionieren wie gewohnt, nur dieses nicht. Sobald die erste Datei gefunden wird, meldet Windows folgenden Fehler:
"135732.xlsm wird momentan von einer anderen Person bearbeitet. Versuchen Sie es später noch einmal."
Ich habe bereits mehrfach versucht, den Code anzupassen – auch mit Unterstützung von KI.
Ich habe folgendes ausprobiert:Read-Only-Modus aktiviert, eine Kopie der Datei erstellt und daraus den Wert ausgelesen, eine 5-Sekunden-Verzögerung eingefügt, falls mein Rechner zu schnell ist.
Leider erhalte ich weiterhin dieselbe Fehlermeldung, dass die Datei von jemand anderem bearbeitet wird.
Ich habe keinen weiteren Rechner zu Hause, um das Problem zu testen, und Windows scheint die Datei zu sperren.
Auch mit Google bin ich nicht wirklich weitergekommen.
Hat jemand Tipps, woran das liegen könnte? Die Pfade sind definitiv korrekt.
dieser Code funktioniert einwandfrei bei der Arbeit mit einem RDP-Server und der gleichen Excel-2016-Version.
In Spalte D steht eine Produktionsnummer, die bereinigt wird. Anschließend wird die Datei nummer.xlsm geöffnet,
der Wert aus Zelle C7 des Tabellenblatts "Eingabe" kopiert und in Spalte G eingefügt, dann die nächste Datei.
Ich wollte den Code zu Hause ausprobieren, habe die gleiche Ordnerstruktur eingerichtet und die Pfade entsprechend angepasst. Alle Skripte funktionieren wie gewohnt, nur dieses nicht. Sobald die erste Datei gefunden wird, meldet Windows folgenden Fehler:
"135732.xlsm wird momentan von einer anderen Person bearbeitet. Versuchen Sie es später noch einmal."
Ich habe bereits mehrfach versucht, den Code anzupassen – auch mit Unterstützung von KI.
Ich habe folgendes ausprobiert:Read-Only-Modus aktiviert, eine Kopie der Datei erstellt und daraus den Wert ausgelesen, eine 5-Sekunden-Verzögerung eingefügt, falls mein Rechner zu schnell ist.
Leider erhalte ich weiterhin dieselbe Fehlermeldung, dass die Datei von jemand anderem bearbeitet wird.
Ich habe keinen weiteren Rechner zu Hause, um das Problem zu testen, und Windows scheint die Datei zu sperren.
Auch mit Google bin ich nicht wirklich weitergekommen.
Hat jemand Tipps, woran das liegen könnte? Die Pfade sind definitiv korrekt.
Code:
Option Explicit
Sub ArtikelnummerAuslesenUndEintragen()
Dim ws As Worksheet
Dim lastRow As Long
Dim prodNum As String
Dim maschine As String
Dim pfad As String
Dim jahrOrdner As String
Dim monatOrdner As String
Dim dateiPfad As String
Dim wbQuelle As Workbook
Dim artikelnummer As String
Dim pruefwert As Variant
Dim i As Long
Dim jahr As Long
Dim monat As Long
Dim reineNummer As String
' Bildschirmaktualisierungen deaktivieren
Application.ScreenUpdating = False
' Aktuelles Tabellenblatt
Set ws = ThisWorkbook.ActiveSheet
maschine = ws.Name
' Letzte Zeile in Spalte D
lastRow = ws.Cells(ws.Rows.Count, "D").End(xlUp).Row
' Schleife durch alle Produktionsnummern in Spalte D
For i = 2 To lastRow
If ws.Cells(i, "D").Value <> "" And (ws.Cells(i, "G").Value = "" Or ws.Cells(i, "J").Value = "") Then
prodNum = ws.Cells(i, "D").Value
' Extrahiere die reine Nummer aus der Produktionsnummer und entferne führende Nullen
If InStr(prodNum, "-") > 0 Then
reineNummer = CStr(CLng(Mid(prodNum, InStr(prodNum, "-") + 1))) ' Führende Null entfernen
Else
reineNummer = CStr(CLng(prodNum)) ' Falls kein Bindestrich vorhanden ist
End If
artikelnummer = "" ' Artikelnummer zurücksetzen
pruefwert = "" ' Prüfwert zurücksetzen
' Suche die Datei in den Jahres- und Monatsordnern
For jahr = Year(Date) - 1 To Year(Date) ' Prüfe die letzten 2 Jahre
jahrOrdner = CStr(jahr)
For monat = 1 To 12
monatOrdner = Format(monat, "00")
'pfad = "\\pm-rdp-003\PRODUKTION\" & maschine & "\Produktion\" & jahrOrdner & "\" & monatOrdner & "\\"
pfad = "C:\LOESCHEN\" & maschine & "\Produktion\" & jahrOrdner & "\" & monatOrdner & "\\"
' Überprüfen, ob die Datei existiert
dateiPfad = pfad & reineNummer & ".xlsm"
If Dir(dateiPfad) <> "" Then
' Datei öffnen
On Error Resume Next
Set wbQuelle = Workbooks.Open(dateiPfad, ReadOnly:=True)
On Error GoTo 0
If Not wbQuelle Is Nothing Then
' Artikelnummer auslesen
On Error Resume Next
artikelnummer = wbQuelle.Worksheets("Eingabe").Range("C7").Value
pruefwert = wbQuelle.Worksheets("Prüfbericht").Range("AW12").Value
On Error GoTo 0
' Datei schließen
wbQuelle.Close SaveChanges:=False
Set wbQuelle = Nothing
' Artikelnummer eintragen, wenn noch nicht vorhanden
If artikelnummer <> "" And ws.Cells(i, "G").Value = "" Then
ws.Cells(i, "G").Value = artikelnummer
End If
' Prüfwert eintragen, wenn noch nicht vorhanden
If Not IsEmpty(pruefwert) And ws.Cells(i, "J").Value = "" Then
ws.Cells(i, "J").Value = pruefwert
'MsgBox pruefwert
End If
' Beende die Schleife, wenn Datei gefunden wurde
Exit For
End If
End If
Next monat
Next jahr
End If
Next i
' Bildschirmaktualisierungen wieder aktivieren
Application.ScreenUpdating = True
' Fertigmeldung
'MsgBox "Artikelnummern und Prüfwerte wurden eingetragen!", vbInformation
End Sub