Live-Forum - Die aktuellen Beiträge
Datum
Titel
29.03.2024 13:14:12
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
920to924
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
920to924
920to924
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Kill geht nicht

Kill geht nicht
07.11.2007 08:47:00
volker
Hai Leute,
mit folgendem makro werden Daten aus bestimmten Mapen ausgelesen.
Wenn dies fertig ist. möchte ich diese Mappe aus dem Ursprungsordner löschen.
hier mein komplettes makro.
Laufzeitfehler 438 bei Zeile
.Filename = wkbMyName ' Hier der Dateiname, muss vorher ausgelesen worden sein, z.B.: _
Kann mir jemand helfen?
Danke Gruss volker

Sub auto_open()
'Zeileneinlesen()
If Cells(2, 5) = 0 Then
Dim unterOdner As Variant, dateien As Variant
Dim oFS As Object, oFLDR As Object, oFILE As Object
Dim lRow As Long
Dim wkbMy As Workbook, wsMy As Worksheet, lngZeile As Long, lngLetzte As Long
'    *Prüfe Inhalt ****************************************************************
Set fs = CreateObject("Scripting.filesystemobject")
Set ordner = fs.getfolder("\\Server04\av\SharePoint_Beschlagliste\Pulk")
unterOdner = ordner.subfolders.Count
dateien = ordner.Files.Count
If (dateien * 1) + (unterOdner * 1) = 0 Then
GoTo Abbruch:
End If
Application.ScreenUpdating = False
'Application.DisplayAlerts = False
Set oFS = CreateObject("scripting.filesystemobject")
lRow = 2
Set oFLDR = oFS.getfolder("\\Server04\av\SharePoint_Beschlagliste\Pulk")
For Each oFILE In oFLDR.Files
If oFILE Like "*.xls" Or oFILE Like "*.xlsm" Or oFILE Like "*.xlsx" Then
lRow = lRow
Set wkbMy = Workbooks.Open(oFILE)
For Each wsMy In wkbMy.Worksheets
If wsMy.Name Like "BL_*" Then
Dim wsMyZeile As Long, wsMyletzte As Long
wsMyletzte = wsMy.Cells(Rows.Count, 1).End(xlUp).Row
For wsMyZeile = 5 To wsMyletzte
If wsMy.Cells(wsMyZeile, 1)  "" Then
wsMy.Range("A" & wsMyZeile & ":B" & wsMyZeile).Copy
ThisWorkbook.Worksheets(1).Cells(lRow, 5).PasteSpecial Paste:= _
xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
wsMy.Range("G" & wsMyZeile & ":N" & wsMyZeile).Copy
ThisWorkbook.Worksheets(1).Cells(lRow, 7).PasteSpecial Paste:= _
xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
wsMy.Range("AA" & wsMyZeile & ":AD" & wsMyZeile).Copy
ThisWorkbook.Worksheets(1).Cells(lRow, 1).PasteSpecial Paste:= _
xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
wsMy.Range("AE" & wsMyZeile & ":AF" & wsMyZeile).Copy
ThisWorkbook.Worksheets(1).Cells(lRow, 13).PasteSpecial Paste:= _
xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
lRow = lRow + 1
End If
Next wsMyZeile
End If
Next
wkbMyName = ActiveWorkbook.Name
wkbMy.Close False
'Datei aus Ursprungsordner löschen
Set oFS = CreateObject("scripting.filesystemobject")
Set fs = CreateObject("Scripting.filesystemobject")
Set ordner = fs.getfolder("\\Server04\av\SharePoint_Beschlagliste\Pulk")
With oFS
  .Filename = wkbMyName  ' Hier der Dateiname, muss vorher ausgelesen  _
worden sein, z.B.: _
If .Execute() > 0 Then
For i = 1 To .FoundFiles.Count
Kill .FoundFiles(i)
Next i
End If
End With
''Kill wkbMy ' Befehl für das löschen der Datei
End If
Next
Speicher = "SharePoint_Beschlagliste"
Pfad = "\\Server04\av\SharePoint_Beschlagliste"
DName = Speicher
Dateiname = Pfad & "\" & DName & "_" & Date & ".xls"
ThisWorkbook.SaveAs Filename:=Dateiname
End If
Application.ScreenUpdating = True
'Application.DisplayAlerts = True
Exit Sub
Abbruch:
Application.DisplayAlerts = False
ActiveWorkbook.Close
' Application.Quit
End Sub


18
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Kill geht nicht
07.11.2007 09:07:58
Hajo_Zi
Hallo Volker,
ist die Datei vielleicht noch auf?
Da gibt es Code um offene Dateien zu löschen. Aber bei VBA bescheiden ist mir dies zu gefährlich.

AW: Kill geht nicht
07.11.2007 09:25:00
volker
Hai Hajo,
wie Du im Code siehst war die offen und wird dann geschlossen.
Danach wollte ich in den betreffenden Ordner gehen um diese zu löschen.
Wenn das anders machbar ist, hab ich nichts dagegen.
Aber wie?
Danke Gruss volker

AW: Kill geht nicht
07.11.2007 09:28:00
Hajo_Zi
Hallo Volker,
ich arbeite mich nicht in Deinen Code ein. Ich würde vermuten solange noch code aus der Datei, die gelöscht werden soll abgearbeitet wird ist sie noch offen.
Gruß Hajo

Anzeige
AW: Kill geht nicht
07.11.2007 09:37:00
volker
Hallo Hajo,
ja die ist noch offen.
Was soll ich machen?
Danke volker

AW: Kill geht nicht
07.11.2007 09:38:00
Wolli
Hallo Volker,
deine Frage ist nicht richtig formuliert. Anscheinend stockt ja das Makro bei
.Filename = wkbMyName
und das heißt, er ist noch gar nicht beim killen angekommen. Lediglich die Zuweisung in dieser Zeile funktioniert nicht.
Da auch ich mich jetzt nicht weiter in den Code einarbeiten mag, musst Du mal prüfen, ob es diese Filename-Eigenschaft des scripting.filesystemobject überhaupt gibt, und welchen Typ und Wert die Var. wkbMyName hat. Es scheint mir sowieso nicht ganz sauber programmiert: Die Variablen sind nicht dimensioniert, der Name "wkbMyName" deutet normalerweise auf eine Variable vom Typ Workbook hin, wird hier aber einige Zeilen zuvor mit einem Namen (=String) gefüllt. Da macht die Fehlersuche keinen Spaß.
Gutes Gelingen anyway, Gruß, Wolli

Anzeige
AW: Kill geht nicht
07.11.2007 10:11:00
volker
Danke Wolli,
ich werd versuchen es irgendwie anders zu probieren.
Gruss volker

AW: Kill geht nicht
07.11.2007 12:27:00
Chris
Servus Volker,
probiers mal so:

Sub auto_open()
'Zeileneinlesen()
If Cells(2, 5) = 0 Then
Dim unterOdner As Variant, dateien As Variant
Dim oFS As Object, oFLDR As Object, oFILE As Object
Dim lRow As Long
Dim wkbMy As Workbook, wsMy As Worksheet, lngZeile As Long, lngLetzte As Long
'    *Prüfe Inhalt ****************************************************************
Set fs = CreateObject("Scripting.filesystemobject")
Set ordner = fs.getfolder("\\Server04\av\SharePoint_Beschlagliste\Pulk")
unterOdner = ordner.subfolders.Count
dateien = ordner.Files.Count
If (dateien * 1) + (unterOdner * 1) = 0 Then
GoTo Abbruch:
End If
Application.ScreenUpdating = False
'Application.DisplayAlerts = False
Set oFS = CreateObject("scripting.filesystemobject")
lRow = 2
Set oFLDR = oFS.getfolder("\\Server04\av\SharePoint_Beschlagliste\Pulk")
For Each oFILE In oFLDR.Files
If oFILE Like "*.xls" Or oFILE Like "*.xlsm" Or oFILE Like "*.xlsx" Then
lRow = lRow
Set wkbMy = Workbooks.Open(oFILE)
Dim wkbMyName As String, pfad As String
wkbMyName = ActiveWorkbook.Name
pfad = ActiveWorkbook.Path
For Each wsMy In wkbMy.Worksheets
If wsMy.Name Like "BL_*" Then
Dim wsMyZeile As Long, wsMyletzte As Long
wsMyletzte = wsMy.Cells(Rows.Count, 1).End(xlUp).Row
For wsMyZeile = 5 To wsMyletzte
If wsMy.Cells(wsMyZeile, 1)  "" Then
wsMy.Range("A" & wsMyZeile & ":B" & wsMyZeile).Copy
ThisWorkbook.Worksheets(1).Cells(lRow, 5).PasteSpecial Paste:= _
_
xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
wsMy.Range("G" & wsMyZeile & ":N" & wsMyZeile).Copy
ThisWorkbook.Worksheets(1).Cells(lRow, 7).PasteSpecial Paste:= _
_
xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
wsMy.Range("AA" & wsMyZeile & ":AD" & wsMyZeile).Copy
ThisWorkbook.Worksheets(1).Cells(lRow, 1).PasteSpecial Paste:= _
_
xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
wsMy.Range("AE" & wsMyZeile & ":AF" & wsMyZeile).Copy
ThisWorkbook.Worksheets(1).Cells(lRow, 13).PasteSpecial Paste: _
= _
xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
lRow = lRow + 1
End If
Next wsMyZeile
End If
Next wsMy
wkbMy.Close False
Dim I As Integer
With Application.FileSearch
.NewSearch
.LookIn = pfad
.Filename = wkbName
If .Execute() > 0 Then
For I = 1 To .FoundFiles.Count
Kill .FoundFiles(I)
Next I
End If
End With
End If
Next oFILE
Speicher = "SharePoint_Beschlagliste"
pfad = "\\Server04\av\SharePoint_Beschlagliste"
DName = Speicher
Dateiname = pfad & "\" & DName & "_" & Date & ".xls"
ThisWorkbook.SaveAs Filename:=Dateiname
End If
Application.ScreenUpdating = True
'Application.DisplayAlerts = True
Exit Sub
Abbruch:
Application.DisplayAlerts = False
ActiveWorkbook.Close
' Application.Quit
End Sub


Gruß´
Chris

Anzeige
AW: Kill geht nicht
07.11.2007 13:25:36
volker
Hai Chris,
freut mich dass Du Dich meiner annimmst.
Leider kommt bei mir Laufzeitfehler 445: Objekt unterstüzt diese Aktion nicht
und zwar in der Zeile
With Application.Filesearch
...hm ich weiss nicht was da zu tun ist..
...noch was: beim testen des makros ist mir aufgefallen, dass die zu öffnenden Dateien immer im Namen erweitert werden. d.h. aus TEST.xls wird TEST1.xls und bei jedem neuen test macht Excel immer +1 dazu.
Ich weiss nicht ob dies zum löschen relevant ist , wollt es nur mal erwähnen.
Danke Dir Gruss volker

AW: Kill geht nicht
07.11.2007 13:31:58
Hajo_Zi
Hallo Volker,
den Befehl Application.Filesearch gibt es in 2007 nicht mehr.
Gruß Hajo

Anzeige
AW: Kill geht nicht
07.11.2007 13:48:00
volker
Hallo Hajo,
Du bist wie mir scheint jemand der ganz gut weiss wie man mit Excel und vba umgeht.
Aber irgendwie werd ich das Gefühl nicht los dass Du eine gewisse Abneigung gegen mich hast.
Warum?
Ich hoffe ich täusch mich.
Gruss volker

AW: Kill geht nicht
07.11.2007 15:57:00
Wolli
Hej Volker, Du täuschst Dich sicherlich. Hajos Beiträge haben oft die Art, sehr einsilbig und direkt zu sein, so dass unscharf formulierte Fragen nicht beantwortet werden. Bzw. wie in diesem Fall zwar eine korrekte Begründung, aber keine dolle Hilfe kommt.
Ist das ewige Problem zwischen den Profis und den Laien :-)
Ich persönlich find's auch nicht so doll. Wenn ich jemandes Intention nicht sicher weiß, versuche ich zu raten oder ich frage oder ich lasse es ganz. Aber jeder wie er will.
Wenn man das Forum so versteht, dass nur ganz eng umrissene Probleme gelöst werden können, liegt Hajo natürlich nicht falsch und in Deinem Fall ist es halt so, dass Du von VBA wenig Ahnung hast, aber mit einem fetten, zusammenkopierten Code daherkommst, der nicht allzuleicht zu durchschauen ist. (ganz neutral gemeint!)
Zu Deinem konkreten Problem: Wenn es die Funktion nicht mehr gibt, muss man sie durch etwas anderes ersetzen. Das kenne ich nicht, aber wenn Du nach einem Nachfolger für den Befehl "Application.Filesearch" suchst oder fragst, kann man Dir bestimmt weiterhelfen. Mach' das ggf. in einem neuen Thread.
Also nochmals gutes Gelingen, Gruß, Wolli

Anzeige
AW: Kill geht nicht
07.11.2007 16:06:56
Chris
Servus miteinander,
naja Hajo ist immer so, hat ja auch durchaus recht. Aber, man gewöhnt sich an alles :-)).
Die 2007 habe ich glatt übersehen, kenne mich aber mit 2007 nicht aus, also auch nicht wodurch .FileSearch ersetzt wurde, wenn überhaupt.
Gruß
Chris

AW: Kill geht nicht
07.11.2007 16:16:21
Wolli
Siehst Du, Volker :-))

AW: Kill geht nicht
07.11.2007 16:36:00
volker
Hallo Hajo,
Danke!
Deine Antwort hat mir gezeigt ich hab mich wohl getäuscht.
Viele Grüsse und schöne Restwoche Volker

Anzeige
AW: Danke für die Info o.T.
07.11.2007 16:45:47
Chris
.

AW: Kill geht nicht
07.11.2007 16:33:40
volker
Servus Chris,
Danke für Deine Antwort
Gruss volker

AW: Kill geht nicht
07.11.2007 16:32:00
volker
Hallo Wolli,
Danke für Deine Antwort, ja ich kann mir denken dass es nicht so einfach ist zwischen Profis und Laien, das kennt jeder.
Ich beherzige Deinen Tipp und probier es mit einer neuen Suche.
...und logisch es ist ein zusammenkopierter Code, richtig.
Irgendwo will ich ja versuchen manche Dinge selbst zu erledigen und aus Unwissenheit bleibt mir nichts anderes übrig.
Ich wünsch Dir einen schöne Woche
Besten Dank Gruss volker

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige