Hallo liebe Forengemeinde,
ich habe in meinem Makro, welches seit einiger Zeit eigentlich super läuft, heute einen Fehler festgestellt. Das Problem liegt am Löschen einer vorher ausgewählten Datei.
Hintergrundinfos:
Excel 2010.
In der Tabelle steht im Worksheet „Alles“ der gesamte Hausrat, wenn was entsorgt wird, muss über ein Formular nur die entsprechende Zeilennummer eingegeben werden und das Makro löscht dann die entsprechende Zeile und, wenn vorhanden und gewollt, auch die dazugehörige Rechnung.
Ob eine Rechnung vorhanden ist steht in Zelle M (13), als "j" oder "n".
Der Dateiname steht in Zelle N (14).
Problem:
Wenn mehrere Dateien existieren deren Dateiname fast identisch ist, wird zwar die richtige Zeile gelöscht, jedoch nur eine der gefundenen Dateien, aber nicht die Datei die ich explizit eingetragen habe. In meinem Fall, hatte ich die Schuhe ausgetragen aber die Gardine wurde gelöscht. Hier die beiden Dateien:
2018_Otto_W3944719_Dockers_Schnuerschuh_dunkelbraun_6954464328.pdf
2018_Otto_W3944719_Gardine_43241079_terrakotta.pdf
Der Code funktioniert sonst, bei komplett unterschiedlichen Dateinamen, problemlos.
Falls noch etwas zur Problemstellung fehlt, einfach Bescheid geben.
Ich hoffe jemand von euch kann mir hier weiterhelfen.
Grüße, Andi
Hier noch der Code:
Option Explicit
Sub Hausrat_loeschen() 'Hausrat löschen
Dim wsa As Worksheet
Dim wsp As Worksheet
Dim ReVorh As Boolean
Dim DateiVorhanden As Boolean
Dim LngZeile As Long
Dim StrPfad As String
Dim StrDatei As String
Dim StrLink As String
Dim objFSO As Object
Set wsa = ActiveWorkbook.Worksheets("Alles") ' Tabelle von Inventar
Set wsp = ActiveWorkbook.Worksheets("Auswertungen") 'Pivottabelle
'Formularfelder auslesen und in Variablen schreiben
With Uf_Hausrat_loeschen
ReVorh = .ObReYes.Value
LngZeile = .TbZeile.Value
End With
With wsa
'Grundeinstellung herstellen (kein Blattschutz, Alles einblenden, keine Filter)
.Unprotect 'Password:=""
.Columns("B:Z").Hidden = False
If .FilterMode Then .ShowAllData
'Zeile löschen
.Rows(LngZeile).Delete
'Rechnung löschen wenn vorhanden und gewollt
StrPfad = "D:\Users\andreas\Documents\Rechnungen\Allgemein\"
StrDatei = .Cells(LngZeile, 14).Value
StrLink = StrPfad & StrDatei & ".pdf"
Set objFSO = CreateObject("Scripting.FileSystemObject")
If objFSO.FileExists(StrLink) = True Then
DateiVorhanden = True
Else
DateiVorhanden = False
End If
Set objFSO = Nothing
If DateiVorhanden = True Then
If .Cells(LngZeile, 13).Value = "j" And ReVorh = True Then
Kill StrLink
Else
End If
Else
End If
End With
'Pivottabelle aktualisieren
wsp.PivotTables("PivotTable2").PivotCache.Refresh
If DateiVorhanden = True Then
If ReVorh = True Then
MsgBox "Hausrat und Rechnung erfolgreich gelöscht!", , "Mitteilung"
Else
MsgBox "Hausrat erfolgreich gelöscht!" & vbNewLine & vbNewLine & "Rechnung nicht gelöscht!", , "Mitteilung"
End If
Else
MsgBox "Hausrat erfolgreich gelöscht!" & vbNewLine & vbNewLine & "Keine Rechnung vorhanden!", , "Mitteilung"
End If
End Sub
|