Moin
Ich habe eine .VBS Datei gefunden die scheinbar genau das macht was ich brauche. Aufgrund von Sicherheitseinstellungen darf ich aber keine .vbs Dateien ausführen. Eigene Makros aus Excel heraus laufen aber ohne Probleme.
Den ersten Teil bekomme ich auch ans laufen, aber bei "Sub OrdnerSucheIn (verz)" (Zeile 93) läuft es dann auf Fehler. Habe den Code einfach als Modul eingefügt und ausgeführt. Was muss ich ändern, damit es komplett läuft? Danke!
Gruß
Knut
CodeTags korrigiert ~VaporiZed
Ich habe eine .VBS Datei gefunden die scheinbar genau das macht was ich brauche. Aufgrund von Sicherheitseinstellungen darf ich aber keine .vbs Dateien ausführen. Eigene Makros aus Excel heraus laufen aber ohne Probleme.
Den ersten Teil bekomme ich auch ans laufen, aber bei "Sub OrdnerSucheIn (verz)" (Zeile 93) läuft es dann auf Fehler. Habe den Code einfach als Modul eingefügt und ausgeführt. Was muss ich ändern, damit es komplett läuft? Danke!
Gruß
Knut
Visual Basic-Quellcode
- Dim ordner(999)
- set MyFiles=CreateObject("Scripting.FileSystemObject")
- Set AppShell = CreateObject("Shell.Application")
- Set BrowseDir = AppShell.BrowseForFolder(0, " Wählen Sie den Ordner der zu konvertierenden DOC-Dateien.", &H1, 17)
- On Error Resume Next
- verz = BrowseDir.ParentFolder.ParseName(BrowseDir.Title).Path
- If Err.Number > 0 Then
- i = InStr(BrowseDir, ":")
- verz = Mid(BrowseDir, i - 1, 1) & ":\"
- End If
- If verz = "" Then Wscript.quit
- ordner(a) = verz
- Set BrowseDir = AppShell.BrowseForFolder(0, " Wählen Sie den Zielordner. Ohne Zielangabe werden alle Dateien in den ursprünglichen Ordnern abgelegt.", &H1, 17)
- ziel = BrowseDir.ParentFolder.ParseName(BrowseDir.Title).Path
- If Err.Number > 0 Then
- i = InStr(BrowseDir, ":")
- ziel = Mid(BrowseDir, i - 1, 2)
- End If
- err.clear
- wdFormat=inputbox("(1) Nur Text - ANSI" & chr(13) & chr(13) & "(2) DOS-Text - ASCII" & chr(13) & chr(13) & "(3) RTF" & chr(13) & chr(13) & "(4) HTML" & chr(13)," DOC-Dateien im folgendem Format speichern:")
- wdformat=wdformat * 2
- if err.number > 0 then wscript.quit
- select case wdformat
- case 2
- erweiterung=".TXT"
- case 4
- erweiterung=".ASC"
- case 6
- erweiterung=".RTF"
- case 8
- erweiterung=".HTM"
- case else
- wscript.quit
- end select
- OrdnerSucheIn ordner(a)
- Set ObjWord = CreateObject("Word.Application")
- with ObjWord
- .visible=TRUE
- .application.WindowState = 0
- .Documents.Add
- .top=3
- .left=100
- .height=22
- .width=400
- .Selection.TypeText "PROTOKOLL DER KONVERTIERUNG" & chr(13) & chr(13)
- end with
- For w = 0 To a
- Set verz=MyFiles.GetFolder(ordner(w))
- Set dat = verz.Files
- For Each datei In dat
- worddatei = datei.Path
- If Right(UCase(worddatei), 4) = ".DOC" Then
- if ziel <> "" then
- outdatei = ziel & "\" & left(datei.name, len(datei.name) - 4) & erweiterung
- else
- outdatei = left(worddatei, len(worddatei) - 4) & erweiterung
- end if
- do
- err.clear
- set kontrolle=myFiles.GetFile(outdatei)
- if err.number = 0 then
- outdatei = left(outdatei,len(outdatei)-4) & "#" & erweiterung
- end if
- loop until err.number > 0
- n = n + 1
- with ObjWord
- .Documents.Open worddatei
- .ActiveDocument.SaveAs outdatei, wdformat
- .ActiveDocument.Close
- .Selection.TypeText worddatei & chr(13) & "===> " & outdatei & chr(13) & chr(13)
- end with
- End If
- Next
- Next
- If n = 0 Then n = "0"
- with ObjWord
- .ActiveWindow.ActivePane.View.Zoom.Percentage = 80
- .Selection.TypeText chr(13) & n & " Datei(en) wurde(n) konvertiert."
- .top=3
- .left=3
- .height=400
- .width=600
- end with
- Sub OrdnerSucheIn (verz)
- set verz=MyFiles.GetFolder(verz)
- Set MoreFolders = verz.SubFolders
- For Each AktuellerOrdner In MoreFolders
- a = a + 1
- ordner(a)=AktuellerOrdner
- OrdnerSucheIn AktuellerOrdner
- Next
- End Sub
CodeTags korrigiert ~VaporiZed
Dieser Beitrag wurde bereits 1 mal editiert, zuletzt von „VaporiZed“ ()