Top-Themen

AppleEntwicklungHardwareInternetLinuxMicrosoftMultimediaNetzwerkeOff TopicSicherheitSonstige SystemeVirtualisierungWeiterbildungZusammenarbeit

Aktuelle Themen

Administrator.de FeedbackApache ServerAppleAssemblerAudioAusbildungAuslandBackupBasicBatch & ShellBenchmarksBibliotheken & ToolkitsBlogsCloud-DiensteClusterCMSCPU, RAM, MainboardsCSSC und C++DatenbankenDatenschutzDebianDigitiales FernsehenDNSDrucker und ScannerDSL, VDSLE-BooksE-BusinessE-MailEntwicklungErkennung und -AbwehrExchange ServerFestplatten, SSD, RaidFirewallFlatratesGoogle AndroidGrafikGrafikkarten & MonitoreGroupwareHardwareHosting & HousingHTMLHumor (lol)Hyper-VIconsIDE & EditorenInformationsdiensteInstallationInstant MessagingInternetInternet DomäneniOSISDN & AnaloganschlüsseiTunesJavaJavaScriptKiXtartKVMLAN, WAN, WirelessLinuxLinux DesktopLinux NetzwerkLinux ToolsLinux UserverwaltungLizenzierungMac OS XMicrosoftMicrosoft OfficeMikroTik RouterOSMonitoringMultimediaMultimedia & ZubehörNetzwerkeNetzwerkgrundlagenNetzwerkmanagementNetzwerkprotokolleNotebook & ZubehörNovell NetwareOff TopicOpenOffice, LibreOfficeOutlook & MailPapierkorbPascal und DelphiPeripheriegerätePerlPHPPythonRechtliche FragenRedHat, CentOS, FedoraRouter & RoutingSambaSAN, NAS, DASSchriftartenSchulung & TrainingSEOServerServer-HardwareSicherheitSicherheits-ToolsSicherheitsgrundlagenSolarisSonstige SystemeSoziale NetzwerkeSpeicherkartenStudentenjobs & PraktikumSuche ProjektpartnerSuseSwitche und HubsTipps & TricksTK-Netze & GeräteUbuntuUMTS, EDGE & GPRSUtilitiesVB for ApplicationsVerschlüsselung & ZertifikateVideo & StreamingViren und TrojanerVirtualisierungVisual StudioVmwareVoice over IPWebbrowserWebentwicklungWeiterbildungWindows 7Windows 8Windows 10Windows InstallationWindows MobileWindows NetzwerkWindows ServerWindows SystemdateienWindows ToolsWindows UpdateWindows UserverwaltungWindows VistaWindows XPXenserverXMLZusammenarbeit
GELÖST

VBA (Word 2003) - Problemchen beim Ersetzen von Zeichen in allen Dateien eines Ordners

Frage Microsoft Microsoft Office

Mitglied: goodbytes

goodbytes (Level 2) - Jetzt verbinden

02.09.2009, aktualisiert 08:19 Uhr, 10574 Aufrufe, 39 Kommentare

Hallo,
ich muss bei etlichen Dateien in einem Ordner mehrere Zeichenketten ersetzen. Da ich es in sehr vielen Ordnern machen muss (immer andere zu ersetzende Zeichenketten) möchte ich dies möglichst per Makro pro Ordner machen.

Folgendes Makro läuft ja schon halbwegs:

01.
Sub ZeichenErsetzen() 
02.
 
03.
    Dim Verz As String 
04.
    Dim DName1 As String 
05.
    Dim DName2 As String 
06.
    Dim Alt As String 
07.
    Dim Neu As String 
08.
     
09.
    Verz = InputBox("Bitte den kompletten Pfad zu dem zu durchsuchenden Ordner eingeben." & Chr(13) & Chr(10) & Chr(10) & "z.B.: C:\Test\", "Pfadangabe...") 
10.
    Alt = InputBox(Chr(10) & "Bitte die zu ersetzende Zeichenkette eingeben...", "Alte Zeichenkette...") 
11.
    Neu = InputBox(Chr(10) & "Bitte die neue Zeichenkette eingeben...", "Neue Zeichenkette...") 
12.
       
13.
    DName1 = Dir(Verz & "*.htm") 
14.
     
15.
    If DName1 <> "" Then 
16.
        Ersetzen1 Verz, DName1, Alt, Neu 
17.
    End If 
18.
     
19.
    Do While (DName1 <> "") 
20.
        DName1 = Dir() 
21.
        If DName1 <> "" Then 
22.
            Ersetzen1 Verz, DName1, Alt, Neu 
23.
        End If 
24.
    Loop 
25.
     
26.
    DName2 = Dir(Verz & "*.rtf") 
27.
     
28.
    If DName2 <> "" Then 
29.
        Ersetzen2 Verz, DName2, Alt, Neu 
30.
    End If 
31.
     
32.
    Do While (DName2 <> "") 
33.
        DName2 = Dir() 
34.
        If DName2 <> "" Then 
35.
            Ersetzen2 Verz, DName2, Alt, Neu 
36.
        End If 
37.
    Loop 
38.
     
39.
End Sub 
40.
  
41.
Sub Ersetzen1(Verz As String, DName1 As String, Alt As String, Neu As String) 
42.
 
43.
    Documents.Open (Verz & DName1) 
44.
    With Documents(DName1) 
45.
        Selection.Find.ClearFormatting 
46.
        Selection.Find.Replacement.ClearFormatting 
47.
            With Selection.Find 
48.
                .Text = Alt 
49.
                .Replacement.Text = Neu 
50.
                .Forward = True 
51.
                .Wrap = wdFindContinue 
52.
                .Format = False 
53.
                .MatchCase = False 
54.
                .MatchWholeWord = False 
55.
                .MatchWildcards = False 
56.
                .MatchSoundsLike = False 
57.
                .MatchAllWordForms = False 
58.
            End With 
59.
        Selection.Find.Execute Replace:=wdReplaceAll 
60.
        ActiveDocument.Save 
61.
        ActiveDocument.Close 
62.
    End With 
63.
     
64.
End Sub 
65.
 
66.
Sub Ersetzen2(Verz As String, DName2 As String, Alt As String, Neu As String) 
67.
 
68.
    Documents.Open (Verz & DName2) 
69.
    With Documents(DName2) 
70.
        Selection.Find.ClearFormatting 
71.
        Selection.Find.Replacement.ClearFormatting 
72.
            With Selection.Find 
73.
                .Text = Alt 
74.
                .Replacement.Text = Neu 
75.
                .Forward = True 
76.
                .Wrap = wdFindContinue 
77.
                .Format = False 
78.
                .MatchCase = False 
79.
                .MatchWholeWord = False 
80.
                .MatchWildcards = False 
81.
                .MatchSoundsLike = False 
82.
                .MatchAllWordForms = False 
83.
            End With 
84.
        Selection.Find.Execute Replace:=wdReplaceAll 
85.
        ActiveDocument.Save 
86.
        ActiveDocument.Close 
87.
    End With 
88.
     
89.
End Sub
Wie man sieht sind es verschiedene Dateitypen. Ích denke mal, dass diese Lösung noch nicht optimal ist.

1. Wenn ich den Pfad leer lasse (weil ich die makrobestückte Datei mit in den zu bearbeitenden Ordner gesteckt habe) versucht er auch gleich noch alle möglichen anderen Dateien zu durchforsten ("Eigene Dateien"). Seltsam. Mit kompletten Pfad gehts dann aber.

2. Den Code zweimal zu machen, nur weil es zwei Dateitypen sind (könnten ja auch mal mehr sein) ist auch sehr unschön. Könnte man das nicht irgendwie eleganter lösen?

3. In diesem Fall muss ich das Makro 4 Mal laufen lassen, da 4 Zeichenketten ersetzt werden müssten. Wäre es da nicht effektiver alle Dialog-Abfragen gleich in einer Maske zu machen (incl. Pfad)? Da komme ich aber mit der InputBox nicht weiter, oder?

4. Eigentlich sind auch noch txt-Dateien dabei. Ich hatte als Dateityp einfach *.* genommen. Allerdings hat Word aus den Zeichen in den Textdateien nur noch Hyroglyphen gemacht.

Oder wäre es günstiger das Ganze gleich mit vbs zu machen? Aber würden dann die ursprünglichen Textformatierungen erhalten bleiben?

Vielleicht kann mir da jemand Tipps geben?

Torsten
39 Antworten
Mitglied: TsukiSan
02.09.2009 um 09:27 Uhr
Hallo TorstenB,

ich denke mit vbs bekommen wir das hin. Mit VBA sicher auch, aber da mache ich zu wenig mit.
in VBS könnte es - rein als Gedanke! - grob so aussehen:
01.
Dim FilterStr , PfadStr 
02.
Dim Alt, Neu 
03.
FilterStr = "*.*" 
04.
Dim MyText(1000), X 
05.
X = 0 
06.
 
07.
Set objWord = CreateObject("Word.Application") 
08.
 
09.
 
10.
PfadStr = inputbox("Bitte den kompletten Pfad zu dem zu durchsuchenden Ordner eingeben.","Pfadangabe...","C:\Test\") 
11.
Alt = inputbox("Bitte die zu ersetzende Zeichenkette eingeben...", "Alte Zeichenkette...", "altes")  
12.
Neu = inputbox("Bitte die neue Zeichenkette eingeben...", "Neue Zeichenkette...", "neues")  
13.
 
14.
msgbox "Befehl wird ausgeführt! Bitte warten!",,"Mit Word...." 
15.
objWord.FileSearch.FileName = FilterStr 
16.
objWord.FileSearch.LookIn = PfadStr 
17.
objWord.FileSearch.SearchSubfolders = False 
18.
objWord.FileSearch.Execute 
19.
 
20.
objWord.Visible = False 
21.
 
22.
 
23.
For Each objFile in objWord.FileSearch.FoundFiles	 
24.
 
25.
Msgbox objFile 
26.
 
27.
 
28.
	Set FSO = CreateObject("Scripting.FileSystemObject") 
29.
	Set MyDatei = FSO.OpenTextFile(objFile, 1) 
30.
 
31.
Do Until MyDatei.AtEndOfStream  
32.
 
33.
	MyText(X) = MyDatei.ReadLine 
34.
	MyText(X) = Replace(MyText(X), Alt, Neu)     
35.
Loop 
36.
 
37.
MyDatei.close 
38.
 
39.
	PfadNeu = objFile & ".bak" 
40.
	Set FSO = CreateObject("Scripting.FileSystemObject") 
41.
	Set MyDatei1 = FSO.CreateTextFile(PfadNeu, TRUE) 
42.
	MyDatei1.Close 
43.
	Set MyDatei1 = FSO.OpenTextFile(PfadNeu, 8) 
44.
	for I = 0 to X 
45.
		if not MyText(I) = "" then MyDatei1.WriteLine (MyText(I)) 
46.
	next 
47.
	MyDatei1.Close 
48.
	 
49.
	X = 0 
50.
Next 
51.
 
52.
 
53.
msgbox "Ferddich..." 
54.
 
55.
 
56.
Set objword = nothing 
57.
Set MyDatei = nothing 
58.
Set FSO = nothing
[Edit] Habe mal den Code noch so geändert, daß die gleichen Dateien mit dem Anhang ".bak" abgespeichert werden, damit du testen kannst, was passiert. Bitte posten, was es noch zu beachten gibt/was nicht funktioniert!
Danke!
[Edit]
Hier nutzen wir Word dazu, um nach Dateien zu suchen. Mit der "Replace"-Methode erstzen wir ALT gegen NEU.
Was jetzt noch geschrieben werden muss ist, daß die einzelnen (NEUEN) Zeilen gespeichert werden und anschließend wieder in deine Datei kommen. Wir hatten gestern einen ähnlichen Beitrag (Ersetzen/neu erstellen von Werten in einer INI-Datei mittels VBS), aber der hilft bei dir nur bedingt.

Soweit erst mal von mir. Muss schon wieder..... hetz

Gruß
Tsuki
Bitte warten ..
Mitglied: goodbytes
02.09.2009 um 14:37 Uhr
Hallo Tsuki,
vielen Dank erstmal für die schnelle Antwort!

Das Skript scheint auch erst einmal über die ersten drei Dateien zu laufen (je eine htm, rtf und txt). Die Kopie (bak) macht es leider nicht sauber (stehen dann nur Rester drin), ist aber auch nicht nötig, da ich die Dateien in der Testphase ohnehin immer wieder frisch reinkopiere.

Wenn die ersten drei Dateien durchlaufen wurden kommt eine Fehlermeldung bezüglich der Zeile 45, Zeichen 30, "Ungültiger Prozeduraufruf oder ungültiges Argument, Code 800A0005.

Torsten
Bitte warten ..
Mitglied: TsukiSan
03.09.2009 um 03:38 Uhr
Hallo TorstenB

Sorry, habe jetzt mal etwas getestet und
folgende Sachen müssen in meinem Script
erst mal geändert werden, damit es prinzipiell
funktioniert:
1) In Zeile 04 bitte die "1000" auf "100000" erhöhen

2)Nach Zeile 34 muss eingefügt werden
01.
	X = X + 1
3)In Zeile 45 anstelle von "If Not...." das ganze
so schreiben, damit auch Leerzeilen einfach
mit übernommen werden
01.
	MyDatei1.WriteLine (MyText(I))
4) vor Zeile 56 noch folgendes einfügen
01.
	objword.quit
So, jetzt hätten wir das ganze mit 3
"Hauptschönheitsfehlern" laufen

Schönheit 1)
- es geht nur mit reinen Textdateien!
Bei Dateien wie WORD, EXCEL, MP3, EXE etc.
wird auf diese Art und Weise was (zumindest)
am Header "reduziert" und die neue Datei ist
nicht mehr lesbar
Schönheit 2)
- Das ganze ist begrenzt auf eine maximale
Zeilenanzahl (original Datei) von 100001
Schönheit 3)
- Wird das Script "langsam" genug ausgeführt,
werden die neu erstellten ".bak"- Dateien
mitverarbeitet und das ganze entwickelt sich
zu einer "never-ending-story"

Also müssen wir mal weiterüberlegen, was zu
machen ist.

Gegenfrage: Sind deine zu ändernden Dateien reine
Textdateien?

Bis später

Gruß
Bitte warten ..
Mitglied: TsukiSan
03.09.2009 um 08:08 Uhr
So, da bin ich kurz wieder,

Habe mal den Script soweit geschrieben (in VBS), daß er zumindest bei Dateien funktioniert, welche reinen Text beinhalten.
Binär-Dateien, etc. funktionieren damit nicht. Da stimmen die Zeilenumbrüche etc. nicht!!!!
01.
Dim FilterStr , PfadStr 
02.
Dim PfadStrNeu, DateiNameNeu 
03.
Dim Alt, Neu 
04.
Dim MyText() 
05.
Dim  X 
06.
Dim ZMAx 
07.
 
08.
FilterStr = "*.*" 
09.
X = 0 
10.
ZMax = 0 
11.
 
12.
 
13.
Set objWord = CreateObject("Word.Application") 
14.
Set FSO = CreateObject("Scripting.FileSystemObject") 
15.
 
16.
 
17.
 
18.
PfadStr = inputbox("Bitte den kompletten Pfad zu dem zu durchsuchenden Ordner eingeben.","Pfadangabe...","C:\Test\") 
19.
PfadStrNeu = PfadStr & "Test\" 
20.
on error resume next 
21.
FSO.CreateFolder(PfadStrNeu) 
22.
 
23.
Alt = inputbox("Bitte die zu ersetzende Zeichenkette eingeben...", "Alte Zeichenkette...", "altes")  
24.
Neu = inputbox("Bitte die neue Zeichenkette eingeben...", "Neue Zeichenkette...", "neues")  
25.
 
26.
msgbox "Befehl wird ausgeführt! Bitte warten!",,"Mit Word...." 
27.
objWord.FileSearch.FileName = FilterStr 
28.
objWord.FileSearch.LookIn = PfadStr 
29.
objWord.FileSearch.SearchSubfolders = False 
30.
objWord.FileSearch.Execute 
31.
 
32.
objWord.Visible = False 
33.
 
34.
FN = "" 
35.
FNR = "" 
36.
 
37.
For Each objFile in objWord.FileSearch.FoundFiles	 
38.
	 
39.
	WScript.Echo "Oeffne Datei: " & ObjFile 
40.
 
41.
'Jetzt holen wir uns nur den Dateinamen raus	 
42.
	FN = "" 
43.
	FNR = "" 
44.
	IFN = "" 
45.
	IFNR = "" 
46.
	for IFN = len(Objfile) to 0 Step -1 
47.
		FNTemp = mid (Objfile,IFN,1) 
48.
			If Not FNTemp = "\" then FN = FN & FNTemp 
49.
			If FNTemp = "\" Then IFN = 0 
50.
	next 
51.
'Hier wieder richtig rum drehen ;-) 
52.
	for IFNR = len(FN) to 1 Step -1 
53.
		FNTempR = mid (FN,IFNR,1) 
54.
			FNR = FNR & FNTempR 
55.
	next 
56.
 
57.
	 
58.
	ZMAx = 0 
59.
	Set MyDatei = FSO.OpenTextFile(objFile, 1) 
60.
 
61.
'Zum bestimmen der maximalen Zeilenzahl in der einzulesenden Datei 
62.
Do Until MyDatei.AtEndOfStream  
63.
	TempText = MyDatei.ReadLine 
64.
	ZMAx = Zmax + 1  
65.
Loop 
66.
MyDatei.close	 
67.
	 
68.
	WScript.Echo "Anzahl Zeilen: " & ZMAx 
69.
	ReDim MyText(ZMax) 
70.
 
71.
 
72.
	Set MyDatei = FSO.OpenTextFile(objFile, 1) 
73.
Do Until MyDatei.AtEndOfStream  
74.
 
75.
	MyText(X) = MyDatei.ReadLine 
76.
	'WScript.Echo "Zeile " & X & ": Suche nach:'" & Alt & "' und ersetze durch:'" & Neu 
77.
	MyText(X) = Replace(MyText(X), Alt, Neu)   
78.
	X = X + 1   
79.
Loop 
80.
	 
81.
MyDatei.close 
82.
	 
83.
 
84.
	PfadNeu = PfadStrNeu & FNR ' & ".bak" 
85.
	WScript.Echo "Daten werden nach " & PfadNeu & " geschrieben." 
86.
 
87.
	Set MyDatei1 = FSO.CreateTextFile(PfadNeu, TRUE) 
88.
	MyDatei1.Close 
89.
	Set MyDatei1 = FSO.OpenTextFile(PfadNeu, 8) 
90.
	for I = 0 to X 
91.
		MyDatei1.WriteLine (MyText(I)) 
92.
	next 
93.
	MyDatei1.Close 
94.
	 
95.
	X = 0 
96.
Next 
97.
 
98.
 
99.
msgbox "Ferddich..." 
100.
 
101.
objword.quit 
102.
 
103.
Set objword = nothing 
104.
Set MyDatei = nothing 
105.
Set FSO = nothing
Hinweis: diesen Code-Schnipsel in eine Textdatei einfügen und als "Test.vbs" umbennen. Dann am besten aus der Kommandozeile ausführen, damit es nicht so viele "Klicks" gibt

Wenn die neue Test.vbs also unter C:\ abliegt dann
Eingabe Kommandozeile :

CScript C:\Test.vbs

Bitte posten, was man verbessern/ändern kann (Gibt immer was!)

Gruß
Tsuki
Bitte warten ..
Mitglied: 76109
04.09.2009 um 19:43 Uhr
Hallo zusammen!

Hier eine Alternative mit Dateitypen-Auswahl (*.vbs)
01.
Option Explicit 
02.
 
03.
Const TitelOrdner = "Ordner-Pfadangabe" 
04.
Const TitelTypen = "Datei-Typen" 
05.
Const TitelSuchen = "Suchen" 
06.
Const TitelErsetzen = "Ersetzen" 
07.
Const TitelAktion = "Suchen und Ersetzen" 
08.
 
09.
Const MsgOrdner = "Bitte den Ordner-Pfad angeben: z.B. C:\Test" 
10.
Const MsgTypen = "Bitte Dateitypen angeben: z.B. * oder rtf,html,..." 
11.
Const MsgSuchen = "Bitte Zeichenkette angeben: Suchen nach..." 
12.
Const MsgErsetzen = "Bitte Zeichenkette angeben: Ersetzen durch..." 
13.
 
14.
Const MsgAktion = "Soll der Ersetzenvorgang jetzt gestartet werden?  " 
15.
Const MsgFertig = "Der Ersetzenvorgang ist abgeschlossen!." 
16.
 
17.
Const MsgFehler = "Die Eingaben sind unvollständig!" 
18.
 
19.
Dim Ordner, Typen, Suchen, Ersetzen, Fso, File, xFile, Extension, Text, i 
20.
     
21.
Ordner = InputBox(MsgOrdner, TitelOrdner):  Typen = InputBox(MsgTypen, TitelTypen) 
22.
Suchen = InputBox(MsgSuchen, TitelSuchen):  Ersetzen = InputBox(MsgErsetzen, TitelErsetzen) 
23.
       
24.
Set Fso = CreateObject("Scripting.FileSystemObject") 
25.
     
26.
If Fso.FolderExists(Ordner) = False Or Typen = "" Or Suchen = "" Then 
27.
    MsgBox MsgFehler, vbExclamation, "Fehler":  WScript.Quit (1) 
28.
End If 
29.
     
30.
If MsgBox(MsgAktion & vbCr & vbCr & "Ordner:" & vbTab & " " & Ordner & vbCr & vbCr & _ 
31.
     "Typen:" & vbTab & " " & Typen & vbCr & vbCr & "Suchen:" & vbTab & " " & Suchen & vbCr & vbCr & _ 
32.
     "Ersetzen:" & vbTab & " " & Ersetzen, vbInformation Or vbOKCancel, TitelAktion) <> vbOK Then WScript.Quit (0) 
33.
     
34.
Typen = Split(Typen, ",") 
35.
     
36.
For Each File In Fso.GetFolder(Ordner).Files 
37.
    Extension = LCase(Fso.GetExtensionName(File.Name)) 
38.
    For i = 0 To UBound(Typen) 
39.
        If Trim(Typen(0)) = "*" Then 
40.
            If Extension = "txt" Or Extension = "rtf" Or Extension = "html" Then i = True: Exit For 
41.
        Else 
42.
            If LCase(Trim(Typen(i))) = Extension Then i = True: Exit For 
43.
        End If 
44.
    Next 
45.
     
46.
    If i = True Then 
47.
        Set xFile = Fso.OpenTextFile(File.Path) 
48.
        Text = Replace(xFile.ReadAll, Suchen, Ersetzen, 1, -1, vbTextCompare) 
49.
        Fso.CreateTextFile(File.Path).Write Text:  xFile.Close 
50.
    End If 
51.
Next 
52.
 
53.
MsgBox MsgFertig, vbInformation, "Meldung":  WScript.Quit (0)
Auch dieses VB-Script gilt nur für Textdateien und es werden keine Sicherungskopien angelegt.

Das Script kann direkt z.B. per Doppelklick gestartet werden.

Eingaben:
1. InpuBox: Ordner-Pfad - z.B. C:\Test
2. InpuBox: Datei-Typen - z.B. txt, rtf, htm, ... oder * (alle Dateien)
3. InpuBox: Text Suchen - z.B. Das ist ein Suchtext
4. InpuBox: Text Ersetzen - z.B. Das ist der neue Text

Ausgaben:
1. MsgBox: Fehlermeldung bei Eingabefehler
2. MsgBox: Frage ob der Vorgang ausgeführt werden soll? (OK/Abbrechen) und Anzeige der Eingaben zur Kontrolle
3. MsgBox: Meldung das der Vorgang abgeschlossen ist.

Probiers mal aus.

Gruß Dieter

[edit] Änderung bei Dateitypen "*" nur *.txt und *.rtf und *.html [\edit]
Bitte warten ..
Mitglied: goodbytes
08.09.2009 um 12:43 Uhr
Hallo Tsuki und Dieter,
sorry, dass ich mich erst jetzt melden kann. Ich hatte nur so viel um die Ohren, dass ich einfach nicht zum Testen kam.

Tsuki, deine vbs-Datei verschiebt die Dateien in den Unterordner, tauscht aber die Zeichen leider nicht aus. Bei der txt-Datei setzt das Skript wischen jedes Zeichen ein "Nullzeichen" (also ich meine damit jetzt nicht die Ziffer Null).

Bei Dieter bekomme ich vom WSH in der Zeile 45:

01.
Fso.CreateTextFile(File.Path).Write Text:  xFile.Close
einen Laufzeifehler: "Ungültiger Prozeduraufruf oder ungültiges Argument" wenn ich alle Typen bearbeiten will und als Dateityp * oder txt nehme. Die vbs entleert dabei die txt-Datei komplett.

Wenn ich einen genauen Daiteityp festlege, z.B. rtf, macht er es. Allerdings wirds dann mit den in der rtf-Datei enthaltenen Formatierungen schwierig, da gerade beim Ersetzen mehrerer voneinander getrennter Wörter nicht gefunden wird. Da hat Word mit dem vba wohl Vorteile. Bei html dürfte es wohl dann die gleichen Probleme geben.

Viele Grüße!

Torsten
Bitte warten ..
Mitglied: 76109
08.09.2009 um 13:51 Uhr
Hallo TorstenB!

Sorry, bei mir funktionierts, daher kann ich das nicht ganz nachvollziehen.

Das die Txt-Datei die Größe Null hat, heißt das der Schreibbefehl "Write Text" nicht ausgeführt wird, wieso auch immer?

In welcher Größenordnung bewegen sich Deine Dateien?

Funktionieren die RTF-Dateien mit dem Script von TsukiSan?

Hast Du das Script direkt gestartet?

Gruß Dieter
Bitte warten ..
Mitglied: goodbytes
08.09.2009 um 15:10 Uhr
Hallo,
habs eben nochmal mit Tsuki`s Script probiert. Das Problem bei rtf- und html-Dateien sind tatsächlich die Formatierungsanweisungen in den Dateien. Bei nur einem zu ersetzenden Begriff gehts aber.

Außer bei der wirklich reinen txt. Da hab ich wie gesagt diese Nullzeichen drin bzw. es geht gar nicht.

Mal eine dumme Frage: Wenn man ohnehin ein Wordobjekt dazu benutzt, kann man nicht auch irgendwie die vba-Anweisungen zum ausführen übergeben?

Dann hätte man mit allen Dateien, mit denen Word umgehen kann, auch keine Probleme bei den Formatierungen (wie z.B. rtf und html).

Ich meine, im Word-Makro siehts ja so aus:

01.
Selection.Find.ClearFormatting 
02.
    Selection.Find.Replacement.ClearFormatting 
03.
    With Selection.Find 
04.
        .Text = "i.A. Torsten Bank" 
05.
        .Replacement.Text = "Alles Kacke !!!" 
06.
        .Forward = True 
07.
        .Wrap = wdFindContinue 
08.
        .Format = False 
09.
        .MatchCase = False 
10.
        .MatchWholeWord = False 
11.
        .MatchWildcards = False 
12.
        .MatchSoundsLike = False 
13.
        .MatchAllWordForms = False 
14.
    End With 
15.
    Selection.Find.Execute Replace:=wdReplaceAll
Ach so, die Dateien sind nicht groß, nur im Kilobyte-Bereich.

Torsten
Bitte warten ..
Mitglied: 76109
08.09.2009 um 15:41 Uhr
Hallo TorstenB!

Wohl doch nicht so einfach, wie ich mir das vorgestellt hatte

Die Textdateien, die Du mit meinem Script getestet hast, wurden die auch mit Word
erstellt bzw. werden die Text-Dateien im Notepad korrekt dargestellt?

Ich teste mal in Word (2002) und schau mal, was dabei rauskommt.

Gruß Dieter
Bitte warten ..
Mitglied: TsukiSan
08.09.2009 um 16:10 Uhr
Hi @ all

ja, bei mir funktioniert es mit Textdateien (auch wenn diese im HTML-Format vorliegen) und mit nur jeweils einem Such-/Erstzenwort. Warum ich Word benutzt habe ist einfach zu erklären:
Damit kann man unter anderem nach Dateien suchen. Ich denke mal, dass man so eventuell auch auf eine VBA-Lösung kommen kann. Allerdings habe ich mit VBA nicht viel am Hut. Aber die Befehle und die "umstände" sollten ähnlich vbs sein. War so meine Idee. Sorry!

Falls ihr beiden was neues habt/rausfindet, dann bitte posten!
Ich lerne gern mit.

Gruß
Tsuki!

Ps.: Bei mir hatte es funktioniert mit WinXP Prof_ENG und Office2000Prof. Ich hatte/habe immer mal wieder Scripte, bei denen das eine ausgeklammerte Wort in einen "KNOW_HOW"-Schutz umgewandelt werden müssen. Da funktioniert es :-\
Bitte warten ..
Mitglied: 76109
08.09.2009 um 19:30 Uhr
@TsukiSan

Welche Suchfunktion letztendlich verwendet wird, ist eigentlich wurscht. Beide funktionieren in VBS und VBA.

Mein Script kann z.B. in ein VBA-Modul kopiert werden, wobei allerdings in der Zeile 19 ein "Sub Irgendwas" und in der Zeile nach 49 ein "End Sub" stehen muss. Ausserdem müssten dann noch "WScript.Quit (1)" durch "Exit Sub" ersetzt werden und "WScript.Quit (0)" am Ende ganz entfallen. Im Anschluss wird der Debugger gestartet <Menu Debugger><Kompilern von Projekt> und solange kein Fehler angezeigt wird, ist alles gut. WScript.Quit (0) wäre z.B. ein Fehler (nicht kompatibel).

In VBA können die DIM-Variablen explizit definiert werden z.B. Dim i As Integer, Fso As Object usw.

Es ist also relativ einfach in VBA einen Code zu entwerfen und mit dem Debugger Schrittweise zu testen und dann in eine Textdatei zu kopieren und diverse kleine Änderungen vorzunehmen.

@torstenb

Hmh, ich stehe ein wenig auf dem Schlauch . Wenn ich in Word (2002) eine RTF- oder TXT-Datei erstelle und mit meinem Script bearbeite, dann funktioniert das Leider. Besitzt Du einen Hex-Editor? Wenn nicht kannst Du Dir hier einen runterladen (Freeware):
http://www.chip.de/downloads/Hex-Editor-MX_30351843.html

Dann schau mal in den Dateien ob z.B. das Wort "Das" im Format: 44 61 73 oder 00 44 00 61 00 73 vorhanden ist

Gruß Dieter
Bitte warten ..
Mitglied: goodbytes
09.09.2009 um 10:15 Uhr
@76109

ich hab jetzt zum Testen die Originaldateien mal über Bord geworfen (auch die txt war mit Word 2003 erstellt).
Irgendwas war an der anders. Wenn ich nun bei deinem Script als Dateityp txt angebe klappt es.
Bei Angabe rtf oder html auch (allerdings nur mit einem zu ersetzenden Begriff).

Wenn ich nun alle Dateitypen behandeln möchte (also mit *) bekomme ich wieder den oben angegebenen Laufzeitfehler und die txt-Datei ist wieder leer (die rtf und html unberührt).

Ach so, das Wort "Das" hat den Wert 646173.

@Tsuki

Mit deinem Script klappt jetzt alles, eben auch mit der Einschränkung des einem zu ersetzenden Begriffs bei rtf und html.

Noch eine kurze Erklärung wozu ich das eigentlich brauche. Meist muss man ja eigentlich nur was einfachen in txt-Dateien ersetzen. In meinem Fall sind es aber diese drei Dateitypen, da es sich um Outlook-Signaturen handelt. Je nach eingesetztem E-Mail-Format (eben nur txt, rtf oder html) wird eine andere Datei verwendet.

Also habe ich in dem "Signatures"-Ordner pro Signatur drei Dateien. Da bei uns immer zwei Unterschriften notwendig sind (mit verschiedenen Vorgesetzten) wird das gleich sehr viel. Der Mitarbeiter mit den meisten Signaturen hat sieben Stück, also 21 Dateien. Und dann müssen bei festgelegten Änderungen die Signaturen von rund 50 Usern angepasst werden...

Torsten

PS: Auf jeden Fall jetzt schonmal ein ganz dickes Dankeschön an euch für die Hilfe !!!
Bitte warten ..
Mitglied: 76109
09.09.2009 um 12:24 Uhr
Hallo zusammen!

Zitat von goodbytes:
Wenn ich nun alle Dateitypen behandeln möchte (also mit *) bekomme ich
wieder den oben angegebenen Laufzeitfehler und die txt-Datei ist wieder leer (die rtf
und html unberührt).
Das ist aber seltsam

Es sei denn, es gibt eventuell ein Missverständnis mit der Eingabe der Dateitypen?

Bisher:
"*" = *.* (alle Dateitypen)
"txt" = *.txt
"txt, rtf" = *.txt und *.rtf
"txt, rtf, html" = *.txt und *.rtf und *.html

Im Code jetzt geändert:
"*" = *.txt und *.rtf und *.html
"txt" = *.txt
"txt, rtf" = *.txt und *.rtf
"txt, rtf, html" = *.txt und *.rtf und *.html


Gruß Dieter
Bitte warten ..
Mitglied: goodbytes
09.09.2009 um 16:38 Uhr
Hallo Dieter,

also, wenn ich nur "*" eingebe kommt der Fehler, allerdings erfolgt das Ersetzen bei rtf und html (zumindest bei einem Begriff) erfolgreich, die txt ist leer.

Mit "*.*", also wie man es normalerweise angibt, kommt der Fehler nicht, aber es findet auch keinerlei Ersetzung in einer der Dateien statt.

Aber mal noch eine andere Frage. Vielleicht stand da schon mal jemand vor so einem kleinen Problem. Es geht auch wieder um Ersetzen, nur etwas anders.

es handelt sich hier um eine html-Datei von meiner ziemlich einfach gestrickten Website für einen Frame mit Thumbnails.
Es kommen ab und zu sehr viele Bilder auf einmal dazu, welche ich als zusätzliche Zeilen einfügen muss. Ich kopiere immer die letzten zwei Zeilen so oft, wie ich neue Bilder habe manchmal gleich so 150 Stück). Kann ich da irgendwie mit einer vbs die Nummerierungen auf einen Rutsch fortlaufend ersetzen z.B. 009.htm und 009.jpg in 010.htm und 010.jpg usw., oder dass sich das Script gleich die Anzahl der neuen jpg`s aus einem definierten Verzeichnis ausliest (dann würde auch das Kopieren am Anfang entfallen)?

Das würde viel Arbeit ersparen (statt mühevoller Tipparbeit immer). Das ganze muss ich ja für zwei im Aufbau identische Frames machen.

Hier die immer gleich aufgebauten zwei Zeilen:

01.
... 
02.
<p align="center"> 
03.
<a href="pages/Linus/001.htm" target="Hauptframe"><img border="0" src="thumbnails/Linus/001.jpg" width="56" height="75"></p> 
04.
<p align="center"> 
05.
<a href="pages/Linus/002.htm" target="Hauptframe"><img border="0" src="thumbnails/Linus/002.jpg" width="56" height="75"></p> 
06.
<p align="center"> 
07.
<a href="pages/Linus/003.htm" target="Hauptframe"><img border="0" src="thumbnails/Linus/003.jpg" width="56" height="75"></p> 
08.
...
Torsten
Bitte warten ..
Mitglied: 76109
09.09.2009 um 17:49 Uhr
Hallo Torsten!

Es wird auf Gleich getestet D.h. Wenn(Input = "*";Dann *.txt und *.rtf und *.html akzeptieren;Sonst überspringen). Alle Dateien bei denen die Dateierweiterung (nach dem Punkt) übereinstimmt wird bearbeitet. Siehe Code Zeile 37 <Variable Extension = Dateierweiterung.

Dein Html-Kopieren wäre auch einfach zu realisieren, aber scheinbar funktioniert ja schon ein einfaches Ersetzen mit den vorherigen Dateien nicht.Und ich habe keine Ahnung wieso? Bei mir funktionierts problemlos. Du könntest mal ein Stück Text aus einer Textdatei in code-Tags setzen.

In Code-Zeile 48 habe ich die Replace-Anweisung erweitert. D.h. Textvergleich ohne Unterscheidung zwischen Groß/Kleinschreibung.

Gruß Dieter
Bitte warten ..
Mitglied: goodbytes
03.10.2009 um 13:24 Uhr
Hallo Dieter,
sorry, dass ich erst jetzt Zeit zum Antworten finde.

Das Ersetzen klappt ja jetzt im Prinzip auch. Es dürfen halt nur keine Leerzeichen enthalten sein. Da dies aber bei mir der Fall war gab es da Probleme. Hab`s jetzt aber nach und nach so fertigbekommen.

Das Erzeugen der HTML-Dateien mit den entsprechenden Nummerierungen gemäss der in einem bestimmten Verzeichnis vorhandenen JPG-Dateien würde mich dennoch interessieren. Die Nummierierung der JPG`s stellt ja hierbei kein Problem dar. Wie könnte ich es am besten hinbekommen? Das würde viel Zeit sparen.

Gruß Torsten
Bitte warten ..
Mitglied: 76109
08.10.2009 um 12:12 Uhr
Hallo TorstenB!

Sorry, Im Moment habe ich wenig Zeit

Das mit den Leerzeichen habe ich nicht so ganz verstanden. Gib mal ein Beispiel.

Die HTML-Dateien müssen leider noch ein paar Tage warten

Gruß Dieter
Bitte warten ..
Mitglied: goodbytes
12.10.2009 um 13:05 Uhr
Hallo Dieter,
ich komme auch leider erst heute zum Antworten; hab momentan auch 'ne Menge um die Ohren.

Wenn eine Zeichenkette wie z. B.:
01.
Dies soll ersetzt werden
genommen wird macht er es nicht. Wenn ich dagegen nur nach:
01.
Dies
suche ersetzt das Skript es.

Gruß Torsten
Bitte warten ..
Mitglied: 76109
12.10.2009 um 14:05 Uhr
Hallo TorstenB!

Sorry, aber das kann ich absolut nicht nachvollziehen. Bei mir funktioniert's und vom Script her müsste es auch funktionieren. Bleibt die Frage, ob die Leerzeichen auch wirklich Leerzeichen (20h) sind. Ich denke, irgendetwas stimmt mit Deinen Dateien nicht.

Gruß Dieter
Bitte warten ..
Mitglied: goodbytes
13.10.2009 um 15:02 Uhr
Hallo Dieter,
ich werd noch mal in Ruhe schauen was mit den Dateien los ist.
Vielen Dank auf jeden Fall erstmal für deine tolle Hilfe !!!

Wenn du mal bei Gelegenheit ein bissl Zeit hast, kannst du mir da vielleicht einen Tipp geben wie ich es auf der Grundlage des jetzigen Skripts mit meinen HTML-Dateien anfangen könnte? Da es dort eine einfache Nummerierung ist stoße ich zumindest nicht auf das Problem mit den Leerzeichen.

Gruß Torsten
Bitte warten ..
Mitglied: 76109
14.10.2009 um 08:33 Uhr
Hallo Torsten!

Die Variante, die Bilder aus einem Verzeichnis einzulesen erscheint mir sinnvoller. Was mir aber noch nicht so ganz klar ist, wie die Bilder in dem Verzeichnis vorliegen. D.h. wenn, wie in Deinem Beispiel schon 3 Bilder definiert sind, befinden sich diese Bilder auch in diesem Verzeichnis und die neuen Bilder haben schon eine fortlaufender Nummer oder haben sie noch keine Nummer und sollen automatisch in eine fortlaufende Nummer erhalten, wobei das erste eingelesene Bild, dass noch noch keine Nummer hat eine fortlaufende Nummer erhalten soll?

Gruß Dieter
Bitte warten ..
Mitglied: goodbytes
15.10.2009 um 10:52 Uhr
Hallo Dieter,
ich war gestern unterwegs und kann deshalb erst heute antworten.

Meine Website ist folgendermaßen aufgebaut (hier als Beispiel mit dem einen Unterordner "Linus", es gibt noch einen zweiten Unterordner neben diesem; es):

.\images\Linus\001.jpg <--- Hier füge ich die fertigen neuen Bilder hinzu mit fortlaufender Nummerierung.
.\thumbnails\Linus\001.jpg <--- Hier füge ich genau wie bei images die Miniaturansichten hinzu.
.\pages\Linus\001.htm <--- Hier gibt es pro Bild eine Website, welche dann im rechten Frame erscheint.

Die Struktur ist sehr einfach aufgebaut, reicht mir ja auch so hin. Ich kopiere praktisch die fertig bearbeiteten Bilder jeweils in den entsprechenden Ordner, nachdem ich sie umbenannt habe (wenn das letzte Bild vorher die Nummer 421.jpg hatte hat das erste von den neuen Bildern jetzt die 422.jpg. Zu jedem großen Bild gibt es natürlich ein kleines Bild mit dem gleichen Dateinamen. In beiden Ordnern ist also immer die gleiche Anzahl von Dateien.

Nach dem Reinkopieren der Bilder fehlen praktisch nur noch dei dazugehörigen HTML-Dateien in dem Ordner "pages" (als Dateiname immer die selbe Nummer wie die JPG`s).

Ich muss mir nun eine der schon vorhandenen HTML-Dateien nehmen (z.B. die 421.htm und die so oft kopieren wie die Anzahl der neuen Bilder ist, dann entsprechend umbenennen in die 422.htm und in der Datei alle Zahlenfolgen "421" mit "422" ersetzen, damit die HTML-Datei das richtige Bild einbindet).

Damit die Dateien im thumbnails-Ordner im rechten Frame der Website angezeigt werden muss ich nun noch für jede neue HTML-Datei im Ordner "pages" zwei neue Zeilen in die für den Frame zuständige HTML-Datei direkt im Root-Verzeichnis ("left.html") erzeugen. Die erste Zeile ist immer nur:
01.
<p align="center">
(Ist eigentlich Quatsch; es reicht ja wenn ich es einmal am Anfang schreibe und nur zum Schluss mit "</p> beende. Werde ich jetzt auch so machen; also ist es nur noch eine Zeile.)

Jede Zeile für ein Thumbnail sieht jetzt praktisch so wie in diesem Beispiel aus:
01.
<a href="pages/Linus/057.htm" target="Hauptframe"><img border="0" src="thumbnails/Linus/057.jpg" width="60" height="75"><br><br>
wenn nach dem letzten
01.
<br><br>
also eine Leerzeile kommt ab da müssen die neuen Zeilen rein.

Zum Schluss muss ich dann noch jeweils die tatsächliche Höhe und Breite der jeweiligen Miniaturansicht anpassen, da sie nicht immer gleich sind.
01.
... width="56" height="75" ...
Diesen Schritt wird man wohl kaum automatisieren können.

Puh, hoffentlich habe ich es halbwegs so geschrieben, dass man es auch verstehen kann...

Gruß Torsten
Bitte warten ..
Mitglied: 76109
15.10.2009 um 11:23 Uhr
Hallo Torsten!

Erstmal Danke für die umfangreiche Info

Ob und wie man die Bildergröße in VBS ermitteln kann, muss ich erst mal austesten.

Gruß Dieter
Bitte warten ..
Mitglied: goodbytes
15.10.2009 um 11:39 Uhr
Hallo Dieter,
aha, meinst du so was würde auch gehen? Das wäre ja ein Ding...
Dann glaube ich schon langsam du kannst zaubern...

Ich hab die verbleibende einzige Zeile pro Thumbnail in der "left.htm" in meinem letzten Kommentar noch mal mit eingefügt. Es gibt übrigens noch eine "right.htm" im Root-Verzeichnis für den rechten Frame mit Thumbnails, da es wie schon angedeutet noch einen zweiten Unterordner neben "Linus gibt, welcher "Andreas" heißt (ich habe zwei kleine Söhne). Die großen Bilder sind dann also in der Mitte zu sehen. Ich würde, wenn ich Bilder in beiden Ordnern hinzugefügt habe ein Skript also zweimal drüberlaufen lassen.

Nur der Vollständigkeit halber...

Gruß Torsten
Bitte warten ..
Mitglied: 76109
15.10.2009 um 12:33 Uhr
Hallo Torsten!

Nö, zaubern kann ich beim besten Willen nicht

Frage: Was passiert, wenn keine Größenangaben gemacht werden?
Wird das Bild dann nicht in seiner Originalgröße angezeigt?

Gruß Dieter
Bitte warten ..
Mitglied: goodbytes
15.10.2009 um 16:03 Uhr
Hallo Dieter,
eigentlich natürlich schon, aber die Bilder unterscheiden sich dummerweise schon etwas in der Größe. Das hatte sich am Anfang irgendwie so ergeben.

Ich müsste dann höchstens alle, die jetzt auf der Website sind durchgehen und auf eine einheitliche Breite bringen. Wäre vielleicht wirklich besser. Ja, das mach ich dann so. Dann lasse ich die Größenangabe weg.

Ich kann dir ja mal irgendwie den Link zukommen lassen, dass du dir ein Bild davon machen kannst. Hier möchte ich ihn aber natürlich jetzt nicht reinsetzen.

Gruß Torsten
Bitte warten ..
Mitglied: 76109
15.10.2009 um 17:11 Uhr
Hallo Torsten!

Also, über Windows Bildaten auszulesen ist recht komplex und sehr aufwendig, aber ich habe gerade eine einfachere Möglichkeitkeit gefunden, die Bildgröße direkt aus der Bild-Datei in Pixel auszulesen. Unabhängig davon ob Du das jetzt noch benötigst oder nicht, werde ich es trotzdem mal als Funktion zusammenbasteln, damit sich die googelei auch gelohnt hat

Gruß Dieter

PS. Den Link kannst Du auch per Nachricht im Admin-Postfach hinterlegen.
Bitte warten ..
Mitglied: goodbytes
15.10.2009 um 22:54 Uhr
Hallo Dieter,
hab dir eben den Link zugeschickt.

Die Thumbnail-Größen habe ich eben alle angepasst; somit ist jetzt auch in der "left.htm" bzw. "right.htm" keine Größenangabe mehr nötig.

Nur diese eine Zeile pro Bild:
01.
<a href="pages/Linus/001.htm" target="Hauptframe"><img border="0" src="thumbnails/Linus/001.jpg"><br><br>
Aber interessant ist es natürlich trotzdem, wie man per Skript in einem Rutsch die Pixelgrößen auslesen und diese Angaben weiterverwenden kann...

Gruß Torsten
Bitte warten ..
Mitglied: 76109
16.10.2009 um 00:02 Uhr
Hallo Torsten!

Eine Funktion zum auslesen der Pixelgrößen habe ich hingekriegt. Der Code hat bei zahlreichen Tests einwandfrei funktioniert. Von daher werde ich den Code dann auch so mit einbinden, das er jederzeit mit minimalem Aufwand aktiviert werden kann. Seperat dazu geht auch ein Script, das ganze Ordner ausliest und die Pixelgrößen in eine Log schreibt. Oder wie auch immer?

Deinen Link werde ich mir jetzt im Anschluß noch anschauen, damit ich mal ein besseres Bild von dem ganzen bekomme

Gruß Dieter
Bitte warten ..
Mitglied: goodbytes
16.10.2009 um 07:38 Uhr
Hallo Dieter,
das wäre ja super, wenn das mit den HTML-Dateien klappen würde. Das würde mir dann jedes Mal viel Arbeit beim Aktuallisieren der Website sparen.

Ich habe mir übrigens doch noch mal die drei Dateitypen zwecks Ersetzen mit dem Editor genauer angeschaut. Bei den txt`s stand auch alles korrekt hintereinander (auch mit Leerzeichen). Da klappte es ja auch.

Probleme gab es dann ja nur bei den rtf und html. Als ich sie mir mit dem Editor anschaute kam mir das blanke Grausen was Word beim Erstellen so angestellt hatte! Da konnte es auch nicht gehen...

Es hat die zu ersetztenden Abschnitte in diesen beiden Dateitypen komplett auseinandergerupft und unsinnigerweise mit unendlich viel Formatierungen dazwischen "garniert". Vielleicht kam dieser Unsinn zustande, weil die Ursprungsdateien mit Word aus Outlook heraus erstellt wurden.

Als ich nun endlich mal eine saubere html und rtf erstellt habe lief es absolut sauber durch.
Ist nur am Anfang durch den Pfad mit Leerzeichen gestolpert.

Geht also 100%-ig !!! Ich bin begeistert !!! Es lag also doch definitiv an meinen Dateien. Hätte eigentlich auch schon mal eher mit dem Editor reinschauen können.

Also vielen vielen Dank für diese saubere Lösung !!!

Gruß Torsten
Bitte warten ..
Mitglied: 76109
16.10.2009 um 22:47 Uhr
Hallo Torsten!

Wußt ich's doch, dass Deine Dateien Schrott sind

Den Vorschlag, die Dateien mal im normalen Text- und Hex-Editor anzusehen, hatte ich aber auch schon mal vorgeschlagen?

Das andere ist in Arbeit.

Ein schönes WE

Gruß Dieter
Bitte warten ..
Mitglied: 76109
18.10.2009 um 13:48 Uhr
Hallo Torsten!

Wenn ich richtig liege, dann müsste die Ordnerstruktur so aussehen:

..\Home\Left- und Right.Htm und andere

..\Home\Pages\Name

..\Home\Thumbnails\Name

..\Home\Images\Name

Ist das so richtig?

Gruß Dieter
Bitte warten ..
Mitglied: goodbytes
19.10.2009 um 18:47 Uhr
Hallo Dieter,
ja, du hast natürlich recht; ich hätte wirklich eher genauer in die Dateien reinschauen sollen. Sorry, Asche auf mein Haupt ...

Mit der Ordnerstruktur hast du so recht. Die left- und right.htm liegen direkt im root-Verzeichnis der Website. Der Rest genau so in den Unterordnern mit den Vornamen der beiden Kleinen.

Gruß Torsten
Bitte warten ..
Mitglied: 76109
19.10.2009 um 19:46 Uhr
Hallo Torsten!

Mhm, was machst Du eigentlich mit der vielen Zeit, die Du durch das Script einsparst. Mit ca 260 Bilder pro Name, also insgesamt 1040 Thumbnails- und Image-Bilder ), hat's bei mir knapp 5 Sekunden gedauert, die Pages-, Left- und Right.Htm's zu erstellen?

Die Vorlage-Dateien müsstest Du per Mail an Deine Web-Mail-Adresse bereits erhalten haben


Funktion des Scripts "CreateHtmFiles.vbs"
- Als Ausgangsbasis werden die Bilder in dem Ordner <Thumbnails> herangezogen
- Die Reihenfolge ist auf die Bildnummer gerichtet.
- Die Bild-Nummern müssen nicht fortlaufend sein. Fehlt z.B. 002.jpg, dann wird eben 1,3,4.. gezählt
- Die Bildnummern können auch 4 oder 5-stellig sein oder sonst eine beliebige sortierbare Bezeichnung haben
- Anhand der Bilder werden die Htm-Dateien Pages Nummer.htm, die Left.htm und Right.htm erstellt/überschrieben
- Zusätzlich zu allen Pfadangaben werden in den Htm's auch die Bildgrößen mit eingefügt (Images u. Thumbnails)


Der Ablauf:
- Kopiere Deinen Home-Ordner in einen Test-Ordner
- Füge im Home-Ordner das Script "CreateHtmFiles.vbs" und die Vorlage-Dateien (*.ht) ein.
- Starte das Script
- Siehe und staune, sofern alles rundläuft?

Kopiere den Quelltext und speichere ihn z.B. unter CreateHtmFiles.vbs im Home-Ordner ab:
01.
Option Explicit 
02.
 
03.
Const Name1 = "andreas"                 'Left 
04.
Const Name2 = "linus"                   'Right 
05.
 
06.
Const HtmLeft = "left.Ht" 
07.
Const HtmRight = "right.Ht" 
08.
Const HtmPages = "pages.Ht" 
09.
 
10.
Const FdPages = "pages\"                'Unterordner 
11.
Const FdImages = "images\" 
12.
Const FdThumbnails = "thumbnails\" 
13.
 
14.
Const adVarChar = 200                   'Konstanten für ADO-Recordset 
15.
Const adFldIsNullable = 32 
16.
 
17.
Const Msg1 = "Die Erstellung der Htm-Dateien ist abgeschlossen." 
18.
 
19.
Const Err1 = "Die Ordnerstruktur ist fehlerhaft!" 
20.
Const Err2 = "Htm-Vorlage (*.ht) nicht gefunden!" 
21.
Const Err3 = "Die Image-Datei existiert nicht: " 
22.
 
23.
'*.ht = [Var $1 = Bild-Nr]  [Var $2 = Name]  [Var $3 = Width]  [Var $4 = Height] 
24.
 
25.
Dim Fso, JpgRec, P0, P1, P2, P3, TP, F1, F2, F3, TF, i 
26.
 
27.
'Main Beg 
28.
     
29.
    Set Fso = CreateObject("Scripting.FileSystemObject") 
30.
     
31.
    P0 = Fso.GetParentFolderName(WScript.ScriptFullName) & "\" 
32.
 
33.
    P1 = P0 & FdPages:  P2 = P0 & FdImages:  P3 = P0 & FdThumbnails 
34.
     
35.
    TP = Array(P1, Name1, P1, Name2, P2, Name1, P2, Name2, P3, Name1, P3, Name2) 
36.
     
37.
    For i = 0 To UBound(TP) Step 2 
38.
        If Fso.FolderExists(TP(i) & TP(i + 1)) = False Then MsgBox Err1, vbExclamation, "Fehler":  WScript.Quit 
39.
    Next 
40.
     
41.
    TF = Array(HtmLeft, HtmRight, HtmPages) 
42.
     
43.
    For i = 0 To UBound(TF) 
44.
        If Fso.FileExists(P0 & TF(i)) = False Then MsgBox Err2, vbExclamation, "Fehler":  WScript.Quit 
45.
    Next 
46.
     
47.
    Call InitHtmFiles(Name1):  Call InitHtmFiles(Name2) 
48.
     
49.
    MsgBox Msg1, vbInformation, "Meldung":  WScript.Quit 
50.
 
51.
'Main End 
52.
 
53.
 
54.
Private Sub InitHtmFiles(ByRef User) 
55.
    Dim File, Text, Jpg, jpgNum, jpgInf 
56.
     
57.
    On Error Resume Next 
58.
     
59.
    Fso.DeleteFile (P1 & User & "\*.htm") 
60.
     
61.
    On Error GoTo 0 
62.
     
63.
    Set File = Fso.OpenTextFile(P0 & HtmPages):  Text = File.ReadAll:  File.Close 
64.
     
65.
    Call OpenJpgRec 
66.
     
67.
    For Each Jpg In Fso.GetFolder(P3 & User).Files 
68.
        If LCase(Right(Jpg.Name, 4)) = ".jpg" Then 
69.
            jpgNum = Fso.GetBaseName(Jpg.Name) 
70.
            jpgInf = GetJpgInfo(Jpg.Path) 
71.
            Call WriteJpgRec(jpgNum, User, jpgInf(0), jpgInf(1)) 
72.
            Call CreatePagesFile(jpgNum, User, Text) 
73.
        End If 
74.
    Next 
75.
     
76.
    If User = Name1 Then 
77.
        Call CreateControlFile(P0 & HtmLeft) 
78.
    ElseIf User = Name2 Then 
79.
        Call CreateControlFile(P0 & HtmRight) 
80.
    End If 
81.
End Sub 
82.
     
83.
Private Sub CreatePagesFile(ByRef jpgNum, ByRef User, ByRef Text) 
84.
    Dim File, PathP, PathI, TextP, jpgInf 
85.
     
86.
    PathP = P1 & User & "\" & jpgNum & ".htm" 
87.
     
88.
    PathI = P2 & User & "\" & jpgNum & ".jpg" 
89.
     
90.
    If Fso.FileExists(PathI) = False Then MsgBox Err3 & PathI, vbExclamation, "Fehler":  WScript.Quit 
91.
     
92.
    jpgInf = GetJpgInfo(PathI) 
93.
             
94.
    TextP = GetVarText(Text, jpgNum, User, jpgInf(0), jpgInf(1)) 
95.
     
96.
    Set File = Fso.CreateTextFile(PathP):  File.Write TextP:  File.Close 
97.
End Sub 
98.
 
99.
Private Sub CreateControlFile(ByRef Path) 
100.
    Dim File, Text, Line 
101.
     
102.
    Set File = Fso.OpenTextFile(Path):  Text = Split(File.ReadAll, "#?#"):  File.Close 
103.
     
104.
    If UBound(Text) = 2 Then 
105.
        Set File = Fso.CreateTextFile(Path & "m"):  File.Write Text(0) 
106.
         
107.
        With JpgRec 
108.
           .Sort = "Num" 
109.
           .MoveFirst 
110.
            Do Until .EOF 
111.
                Line = GetVarText(Text(1), .Fields(0), .Fields(1), .Fields(2), .Fields(3)) 
112.
                File.WriteLine Line 
113.
               .MoveNext 
114.
            Loop 
115.
        End With 
116.
         
117.
        File.Write Text(2) 
118.
    End If 
119.
     
120.
    JpgRec.Close:  File.Close 
121.
End Sub 
122.
 
123.
Private Sub OpenJpgRec() 
124.
    Set JpgRec = CreateObject("ADOR.Recordset") 
125.
    With JpgRec.Fields 
126.
        .Append "Num", adVarChar, 32, adFldIsNullable 
127.
        .Append "User", adVarChar, 32, adFldIsNullable 
128.
        .Append "Width", adVarChar, 16, adFldIsNullable 
129.
        .Append "Height", adVarChar, 16, adFldIsNullable 
130.
         JpgRec.Open 
131.
    End With 
132.
End Sub 
133.
 
134.
Private Sub WriteJpgRec(ByRef jpgNum, ByRef User, ByVal jpgWidth, ByVal jpgHeight) 
135.
    With JpgRec 
136.
        .AddNew 
137.
        .Fields("Num") = jpgNum 
138.
        .Fields("User") = User 
139.
        .Fields("Width") = jpgWidth 
140.
        .Fields("Height") = jpgHeight 
141.
        .Update 
142.
    End With 
143.
End Sub 
144.
 
145.
Private Function GetJpgInfo(ByRef Path) 
146.
    Dim File, c, s, jpgWidth, jpgHeight 
147.
     
148.
    Set File = Fso.OpenTextFile(Path) 
149.
   
150.
    GetJpgInfo = Array("", "") 
151.
     
152.
    If File.Read(2) = Chr(&HFF) & Chr(&HD8) Then 
153.
        Do While File.Read(1) = Chr(&HFF) 
154.
            c = Asc(File.Read(1)) 
155.
             
156.
            s = File.Read(Asc(File.Read(1)) * 256 + Asc(File.Read(1)) - 2) 
157.
             
158.
            If c = &HC0 Or c = &HC2 Then 
159.
                jpgWidth = Asc(Mid(s, 4, 1)) * 256 + Asc(Mid(s, 5, 1)) 
160.
                jpgHeight = Asc(Mid(s, 2, 1)) * 256 + Asc(Mid(s, 3, 1)) 
161.
                GetJpgInfo = Array(jpgWidth, jpgHeight):  Exit Do 
162.
            End If 
163.
        Loop 
164.
    End If 
165.
    File.Close 
166.
End Function 
167.
 
168.
Private Function GetVarText(ByRef Text, ByVal s1, ByVal s2, ByVal s3, ByVal s4) 
169.
    Dim Arg, i 
170.
     
171.
    GetVarText = Text:  Arg = Array(0, s1, s2, s3, s4) 
172.
     
173.
    For i = 1 To UBound(Arg) 
174.
        GetVarText = Replace(GetVarText, "$" & (i), Arg(i)) 
175.
    Next 
176.
End Function

Noch eine Anmerkung zu den Vorlage-Dateien (*.ht):
Das sind normale Htm-Dateien, in denen an verschiedenen Stellen eine Variable steht. In diesem Fall sind es die Variablen "$1", "$2", "$3" und "$4" und werden durch einen Namen, eine Bildnummer und der Bildgröße Width und Height ersetzt.

Gruß Dieter

[edit] Letzte Änderung 21.10.2009 13:30 Die GetJpgInfo-Funktion optimiert [/edit]
Bitte warten ..
Mitglied: 76109
20.10.2009 um 12:11 Uhr
Hallo!

Die Bildgröße auszulesen, würde auch so gehen. Allerdings ist diese Methode um ein vielfaches langsamer.

01.
    Set Shell = CreateObject("Shell.Application")
Die Prozedur ab Zeile 54 würde dann so aussehen:
01.
Private Sub InitHtmFiles(ByRef User) 
02.
    Dim File, Path, Text, Jpg, JpgNum, jpgWidth, jpgHeight 
03.
     
04.
    On Error Resume Next 
05.
     
06.
    Fso.DeleteFile (P1 & User & "\*.htm") 
07.
     
08.
    On Error GoTo 0 
09.
     
10.
    Set File = Fso.OpenTextFile(P0 & HtmPages):  Text = File.ReadAll:  File.Close 
11.
     
12.
    Call OpenJpgRec 
13.
     
14.
    Path = P3 & User 
15.
     
16.
    For Each Jpg In Shell.Namespace(Path).Items 
17.
        If LCase(Right(Jpg.Name, 4)) = ".jpg" Then 
18.
            JpgNum = Fso.GetBaseName(Jpg.Name) 
19.
            jpgWidth = Split(Shell.Namespace(Path).GetDetailsOf(Jpg, 27))(0) 
20.
            jpgHeight = Split(Shell.Namespace(Path).GetDetailsOf(Jpg, 28))(0) 
21.
            Call WriteJpgRec(JpgNum, User, jpgWidth, jpgHeight) 
22.
            Call CreatePagesFile(JpgNum, User, Text) 
23.
        End If 
24.
    Next 
25.
     
26.
    If User = Name1 Then 
27.
        Call CreateControlFile(P0 & HtmLeft) 
28.
    ElseIf User = Name2 Then 
29.
        Call CreateControlFile(P0 & HtmRight) 
30.
    End If 
31.
End Sub
Und die Funktion <GetJpgInfo> würde ganz entfallen

Gruß Dieter
Bitte warten ..
Mitglied: goodbytes
20.10.2009 um 19:01 Uhr
Hallo Dieter,
also das klappt ja echt perfekt (und auch sehr schnell) Habs mit dem (noch) aktuellen Stand der Website probiert)

Du hast recht - es ist ja Wahnsinn was ich mit dem Script an Zeit spare. Ich denke ich werde die gewonnene Zeit meinen Beiden kleinen Jung`s zugute kommen lassen (um die Beiden geht`s ja schließlich auf meiner Website). Die freuen sich, wenn Papa mal abends mehr Zeit hat um mit Bausteinen Burgen zu bauen usw.

Ich finde es auch gut, dass mich das Script (logischerweise) "angemeckert" hat, dass die Datei "062.jpg" gefehlt hat. Da vom Thumbnails-Ordner ausgegangen wird, wo eine Datei "062.jpg" existierte, im Ordner "images" aber versehentlich nicht, lief das Script auf einen Fehler. Aber so bekommt man es wenigstens auch mit.

Die Bildgröße hab ich den ht-Dateien erstmal vorläufig rausgenommen, da ich alle Thumbnails in der Größe angepasst habe. Kann aber sein, dass ich die Website mal irgendwie umkrempel und dann mit Sicherheit diese Funktion benötige.

Dein letztes Posting zwecks der Bildgröße werde ich morgen mal einfügen.

Momentan möchte ich dir aber erstmal ganz ganz ganz dick Danke !!! sagen für deine Mühe !!!
Hast du mächtig gut gebastelt.

Einen schönen Abend wünsch ich dir noch!

Gruß Torsten
Bitte warten ..
Mitglied: 76109
20.10.2009 um 19:14 Uhr
Hallo TorstenB!

Yep, habe ich doch gern getan - aber nur - damit Du mehr Zeit für Deine Kinder und Deine Frau aufbringst.

Den letzten Code-Schnipsel würde ich NICHT einfügen. Er ist zwar kürzer und vielleicht auch hübscher, aber er ist viel viel viel langsamer, als der im Hauptscript.
Den Code habe ich eigentlich nur der Vollständigkeit halber gepostet, um zu zeigen, wie es auch geht.

Na, dann noch viel Spaß

Gruß Dieter

PS Das Hauptscript wurde geändert. GetJpgInfo-Funktion optimiert
Bitte warten ..
Mitglied: goodbytes
21.10.2009 um 15:59 Uhr
Hallo Dieter,
ich hab gestern abend schon mal einen ganzen Schwung Bilder bearbeitet und dann heute mit deinem Script die htm's erzeugt (hab die Änderung im Script mit reingenommen). Einfach Klasse, was das für Zeit spart. Vor allem kann ich jetzt auch in der Nummerierung dazwischen schnell mal Bilder einfügen, da die htm`s ja ohnehin neu erzeugt werden.

Vielen vielen Dank nochmal !!!

Gruß Torsten
Bitte warten ..
Mitglied: 76109
21.10.2009 um 16:13 Uhr
Hallo Torsten!

Zitat von goodbytes:
Vor allem kann ich jetzt auch in der Nummerierung dazwischen schnell mal Bilder einfügen, da die htm`s ja ohnehin neu erzeugt werden.
Ja, da kann man mal sehen, dass ich ein weinig mitgedacht habe

Freut mich, dass Du zufrieden bist

Gruß Dieter
Bitte warten ..
Neuester Wissensbeitrag
Humor (lol)

Linkliste für Adventskalender

(3)

Information von nikoatit zum Thema Humor (lol) ...

Ähnliche Inhalte
Microsoft Office
gelöst VBA Word IBAN zerschneiden (8)

Frage von InSpee zum Thema Microsoft Office ...

Windows Netzwerk
Windows Server 2003 SBS Netzwerk durch neuen Server Ersetzen (9)

Frage von MultiStorm zum Thema Windows Netzwerk ...

VB for Applications
Dateien in Tabellenblat mit VBA beladen (8)

Frage von lupi1989 zum Thema VB for Applications ...

VB for Applications
gelöst VBA Text mit Format übertragen und Zeichen ergänzen (11)

Frage von Dau12345 zum Thema VB for Applications ...

Heiß diskutierte Inhalte
Windows Server
DHCP Server switchen (25)

Frage von M.Marz zum Thema Windows Server ...

SAN, NAS, DAS
gelöst HP-Proliant Microserver Betriebssystem (14)

Frage von Yannosch zum Thema SAN, NAS, DAS ...

Grafikkarten & Monitore
Win 10 Grafikkarte Crash von Software? (13)

Frage von Marabunta zum Thema Grafikkarten & Monitore ...

Router & Routing
gelöst Empfehlung günstiges ADSL2+ nur Modem (10)

Frage von TimMayer zum Thema Router & Routing ...