Anzeige
Archiv - Navigation
1444to1448
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
Inhaltsverzeichnis

Shapes löschen

Shapes löschen
04.09.2015 10:25:18
Wolf
Hallo Michael,
es tut mir leid das ich mich jetzt erst melde, aus der Reha kam ich nochmal in das Krankenhaus.
Jetzt geht es mir wieder besser und konnte mich auch ausgiebig mit Deinem letzten Script befassen.
Es ist jetzt die richtige Richtung, allerdings müsste noch etwas verändert werden.
Ich brauche nur Temp1 - ohne X-Dateien.
Davon Sheet001, HTM-Datei, allerdings diese als reine html-Datei, so wie es das Script von
Josef Ehrensberger liefert. Alles andere was in Temp1 noch drin ist, ist nicht notwendig.
Wenn dann das so in der Form in das Script von Sepp eingebaut wird, wäre ich happy.
Dir einen schönen Tag
Wolf

Sub DownloadFiles()
Dim lngResult As Long, lngRow As Long, lngLast As Long
Dim strFolder As String, strError As String
strFolder = "C:\Users\Wolf Ludwig\Documents\Download" 'Zielverzeichnis - Anpassen
If Right(strFolder, 1)  "\" Then strFolder = strFolder & "\"
lngLast = Cells(Rows.Count, 2).End(xlUp).Row
For lngRow = 1 To lngLast
lngResult = URLDownloadToFile(0, Cells(lngRow, 3), strFolder & Cells(lngRow, 2) & ".html", 0,  _
_
_
0)
If lngResult  0 Then
strError = strError & Cells(lngRow, 3) & vbLf
End If
Next
If Len(strError) > 0 Then
MsgBox "Folgende Dateien konnten nicht geladen werden!" & vbLf & vbLf & _
strError, vbInformation, "Hinweis"
End If
End Sub

6
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Shapes löschen
04.09.2015 22:10:52
Michael
Hallo Wolf,
irgendwie habe ich das Gefühl, wir reden nur aneinander vorbei.
Ich hatte gehofft, Dir klar zu machen, daß das Skript vom Josef KEINE Möglichkeiten des Eingriffs bietet, derweil der Befehl
URLDownloadToFile

die komplette HTML-Datei kopiert und speichert.
Funktioniert denn der Code hier:
Public Sub machs()
Dim WB As Workbook
Dim shp As Shape
Set WB = Workbooks.Open("https://www.herber.de/autor.html")
With WB
.SaveAs "C:\Dein_Ordner\Download\Herber_mit_X.xls"
.SaveAs "C:\Dein_Ordner\Download\Herber_mit_H.htm"
' ********************************* von hier ***********************
For Each shp In .ActiveSheet.Shapes
shp.Delete
Next
' **** bis hier werden alle Shapes gelöscht ************************
.SaveAs "C:\Dein_Ordner\Download\Herber_ohne_X.xls"
.SaveAs "C:\Dein_Ordner\Download\Herber_ohne_H.htm"
.Close True
End With
End Sub
Wenn ja, dann brauchst Du nur die drei Zeilen mit den ersten .SaveAs auszukommentieren, so daß nur die unterste .SaveAs - Zeile stehen bleibt, mit der HTM *ohne* die Shapes gespeichert wird.
WENN das zufriedenstellend funktioniert, kann man wiederum die Schleife drumherumbauen.
Schöne Grüße,
Michael

Anzeige
AW: Shapes löschen
07.09.2015 12:48:15
Wolf
Hallo Michael,
Danke für Deine nochmalige Mühe und Nachricht.
Ich habe zum Glück eine Lösung für das Shapes Problem gefunden.
Mit einem Externen Programm "Suchen und Ersetzen" kann ich im
Quellcode der html-Seiten die "image-gif" dateiübergreifend löschen.
Das geht einfach und ratzfatz.
In einem Punkt möchte ich Dich nocheinmal um Deine Hilfe bitten.
Bei mir ist immer noch das Problem, einzelne html-Dateien in einzelne
Windows Ordner verschieben offen. Ich habe im HERBER-Archiv etwas gefunden,
aber damit kann ich nichts anfangen, vielleicht kannst Du mir da weitehelfn.
https://www.herber.de/forum/archiv/648to652/t648877.htm
Nochmals Danke und einen schönen Tag
Wolf

Anzeige
wer anders bitte - nur aus Zeitmangel
08.09.2015 11:24:09
Michael
Hallo Wolf,
Du hattest ja im ersten Thread eine Datei hochgeladen, in der Sepps Code sich die Infos zur URL aus Spalte C und den Dateinamen zum Speichern aus Spalte B geholt hat.
Wie stellst Du Dir das mit "in einzelne Ordner verschieben" vor? Willst Du das gleich beim Herunterladen erledigen?
Dann kannst Du übrigens in Spalte B weitere Unterordner vor den Dateinamen angeben, z.B. statt jetzt import.html einfach weitererOrder\import.html
Das wird dann an den vorhandenen Pfad ...
strFolder = "C:\Users\Wolf Ludwig\Documents\Download"
If Right(strFolder, 1)  "\" Then strFolder = strFolder & "\"

... angehängt und speichert dann so:
C:\Users\Wolf Ludwig\Documents\Download\weitererOrder\import.html
Oder soll das ein extra Programm sein?
Schöne Grüße,
Michael

Anzeige
sorry, falscher Betreff owT
08.09.2015 16:53:57
Michael

AW: sorry, falscher Betreff owT
08.09.2015 21:09:30
Wolf
Guten Abend Michael,
Ich wäre Dir dankbar, wenn Du es als extra Programm machen könntest. Ich brauche die Dateien einmal im gesamten und einmal je eine im einzelnen Ordner. Dateiname soll gleich Ordnername sein.
Viren Dank im voraus.
Wolf

AW: sorry, falscher Betreff owT
09.09.2015 14:35:11
Michael
Hallo Wolf,
wie vernagelt man sein kann...
So habe ich mir den Code vorgestellt:
Sub kopieren()
Dim von$, nach$, name$, ohneExt$
Dim punkt&
von = Range("C2").Value
If Right(von, 1)  "\" Then von = von & "\"
nach = Range("C4").Value
If Right(nach, 1)  "\" Then nach = nach & "\"
If von = nach Then
MsgBox "Pfade müssen unterschiedlich sein!"
End
End If
'' Für ALLE Datein im Ordner
'name = Dir(von, vbNormal)
' ODER nur für *.htm*:
name = Dir(von & "*.htm*", vbNormal)
While name  ""
' für Ordnernamen OHNE Extension, also ohne das .HTM(L)
punkt = InStrRev(name, ".")
ohneExt = Mid(name, 1, punkt - 1)
MkDir nach & ohneExt
FileCopy von & name, nach & ohneExt & "\" & name
' ' oder MIT Extension:
'  MkDir nach & name
'  FileCopy von & name, nach & name & "\" & name
' ' MIT Extension Ende
name = Dir
Wend
End Sub

... aber er hat auf Anhieb (ohne If von = nach Then) nicht funktioniert.
Warum? Weil kein Ordner mit dem gleichen Namen wie eine bereits vorhandene Datei angelegt werden kann.
Also: bitte unterschiedliche Ordner verwenden. Oder gleiche Ordner, aber mit Verzeichnisnamen OHNE Extension.
In C2 gibst Du den kompletten Pfad ein, in dem sich die Datein befinden, in C4 den Ordner, in dem die neuen Ordner samt Datei-Kopien angelegt werden sollen.
Der Code ist kurz getestet, aber ohne Errorhandling. Interessant ist in dem Zusammenhang auch:
http://www.office-loesung.de/ftopic585400_0_0_asc.php
Dort werden API- anstatt der eingebauten Excel-Funktionen verwendet.
Schöne Grüße,
Michael
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige