PDA

Vollständige Version anzeigen : Dir findet trotz Angabe von *.doc, auch *.docx-Dokumente


Custer
09.07.2014, 19:54
Hallo zusammen

Ich habe ein Problem:

Die Aufgabe dieses Codes sollte darin bestehen, Dateien mit der entsprechenden Word-Endung in einem Verzeichnis zu finden.

Jetzt habe ich eine Combobox1 kreiert, welche zur Auswahl .docx und .doc hat.

Diesen Wert übergebe ich an den Dir Befehl:

StrName = Dir(strOrdnerName & "*" & UserForm1.ComboBox1.Value)

Ich hatte bereits ein Makro, aber mit OptionButtons, welches funktionierte und nur .doc Dateien auflistete.

Plötzlich jedoch listet es mir, obwohl ich nur nach *.doc Suche, auch die *.docx-Dateien auf. Wieso das? Wenn ich dem Dir doch sage, dass ich *.doc will und nicht *.doc*, sollte das doch klappen oder verstehe ich irgendwas falsch? Bzw. klappte es ja vorher einwandfrei. Wo liegt mein Fehler?

Durch die Debug.Print Befehle kann ich mit 100%iger Sicherheit sagen, dass es auch die .docx-Dateien auflistet.

Bereits ein Dankeschön an die fleissigen Helfer :)

Lg

Custer

Sub PDFErstellen()
'Schleife
Dim strOrdnerName As String
Dim StrName As String
Dim vollpfad As String
Dim intz As Integer
'PDF
Dim objDoc As Object
Dim wrdDoc As Object
Dim Dateiname As String, strFilename As String, strTempBuffer As String, Pfad As String

If Not Word_Connect Then _
Exit Sub
On Error GoTo Fehler
EreignisseAus

strOrdnerName = UserForm1.TextBox1.Value & "\"

'Abfrage ob .docx oder .doc gewählt wurde, entsprechend wir nach den mit der Endung Dateien gesucht

StrName = Dir(strOrdnerName & "*" & UserForm1.ComboBox1.Value)
Debug.Print UserForm1.ComboBox1.Value
UserForm1.Label5.Caption = "Konvertierung läuft, bitte warte einen Moment..."
UserForm1.Label5.Visible = True
Do While StrName <> ""
vollpfad = strOrdnerName & StrName
Set objDoc = CreateObject("Word.Application")
Set wrdDoc = objDoc.Documents.Open(vollpfad)
Debug.Print vollpfad
'Abfrage ob .docx oder .doc gewählt wurde (entsprechen wird doc oder docx durch PDF ersetzt
If UserForm1.ComboBox1.Value = ".docx" Then
vollpfad = Replace(vollpfad, "docx", "pdf")
Else
vollpfad = Replace(vollpfad, "doc", "pdf")
End If
Debug.Print vollpfad
wrdDoc.ExportAsFixedFormat OutputFileName:= _
vollpfad, ExportFormat:=17, _
OpenAfterExport:=False, OptimizeFor:=0, Range:= _
0, From:=1, To:=1, Item:=0, _
IncludeDocProps:=True, KeepIRM:=True, CreateBookmarks:= _
0, DocStructureTags:=True, BitmapMissingFonts:= _
True, UseISO19005_1:=False
wrdDoc.Close SaveChanges:=False
intz = intz + 1
StrName = Dir
Loop

aloys78
10.07.2014, 06:44
Hallo Custer,
Ich hatte bereits ein Makro, aber mit OptionButtons, welches funktionierte und nur .doc Dateien auflistete.
Dazu kann ich nichts sagen, da du dieses Makro hier nicht vorgestellt hast.
Plötzlich jedoch listet es mir, obwohl ich nur nach *.doc Suche, auch die *.docx-Dateien auf.
Plötzlich ist mE nicht die richtige Beschreibung; ich kann das aber nachvollziehen, wenn ich mit der Funktion Dir arbeite.

Eine Möglichkeit wäre, deinen Code ein wenig zu erweitern. Nachstehend dazu ein kleines Test-Beispiel:
Sub Test()
Dim strOrdnerName As String
Dim StrName As String
Dim vollpfad As String

Dim Endung As String 'doc oder docx
Dim L_Endung As Integer 'Länge DateiTyp

Endung = ".doc" 'Vorgabe für die Auswahl aus ComboBox

L_Endung = Len(Endung)
strOrdnerName = ThisWorkbook.Path & "\"
StrName = Dir(strOrdnerName & "*" & Endung)
Do While StrName <> ""
If Right(StrName, L_Endung) = Endung Then
MsgBox StrName
End If
StrName = Dir ' Nächsten Eintrag abrufen.
Loop
End Sub

Custer
10.07.2014, 08:14
Hallo aloys

Vielen Dank für deine Hilfe. Ich konnte deinen Vorschlag noch nicht vollständig testen in meinem Makro, werde es aber später noch tun.

Dein Beispiel funktioniert einwandfrei :)

Gäbe es eigentlich eine andere Möglichkeit, als mit dem Dir-befehl?

Ich selbst verwende Excel 2013 und schreibe die Makros jeweils mit diesem. Auf einem weiteren Laptop für die Ausbildung habe ich jedoch Excel 2010. Ich habe ständig das Problem, dass das Makro im Excel 2013 läuft aber auf dem 2010er nicht. Ständig meldet es Befehle, welche anscheinend nicht existieren. Mir ist das Problem mit den Konstanten bekannt und auch die Einstellung mit der Bibliothek. Aber ich kann doch nicht von jedem benutzer verlangen, dass er jeweils die Bibliothek zuerst entfernen geht, bzw. der Haken.

In meinem Script hat Excel 2010 das Problem mit dem Befehl Right. Letztes Mal war es der Befehl Date. Solche Befehle sind doch nahezu in jeder Excel-Version bekannt? Weshalb bekomme ich da Fehler?


Lg

Custer

aloys78
10.07.2014, 08:37
Hallo Custer,
Gäbe es eigentlich eine andere Möglichkeit, als mit dem Dir-befehl?
Sicherlich - zum Besipiel
- das FislSystemObject(FSO) der Scripting Runtime, und
- eine API-Funktion
Für deinen Fall ist Dir mE ausreichend; von Schwierigkeiten mit Excel 2010 habe ich bisher noch nicht gehört
Auf einem weiteren Laptop für die Ausbildung habe ich jedoch Excel 2010. Ich habe ständig das Problem, dass das Makro im Excel 2013 läuft aber auf dem 2010er nicht.
Ggf hilft dir hierzu ein eigener Thread zu dieser Thematik, bei dem du dann auch konkrete Beipiele vorstellen kannst. Hier im Forum gibt es genügend Helfer, die beide Versionen 2010 und 2013 nutzen.

Gruß
Aloys

Office 2010

haklesoft
10.07.2014, 08:50
In meinem Script hat Excel 2010 das Problem mit dem Befehl Right. Letztes Mal war es der Befehl Date. Solche Befehle sind doch nahezu in jeder Excel-Version bekannt? Weshalb bekomme ich da Fehler?Hallo Custer,

nicht Right oder Date sind kaputt, sondern Du hast ein Verweis-Problem.

Wenn Du auf dem Office2010-Rechner entwickeln würdest, gäbe es das nicht, denn die Aufwärtskompatibilität klappt ganz gut.

Andersherum gibt es dafür aber keine Gewähr.

Solange Du keine spezifischen Office2013-Neuerungen einsetzt könntest Du auch weiterhin auf dem Office2013-Rechner entwickeln, die Verweise in den Dateien aber vor dem Verteilen an andere auf Deinem Office2010-Rechner umsetzen.

Nepumuk
10.07.2014, 08:56
Hallo,

da muss ich Aloys widersprechen. Diese beiden Möglichkeiten sind noch unspezifischer als die DIR-Funktion. Denn diese lesen grundsätzlich alle Dateien eines Ordners und du musst bei jeder Datei die Endung abfragen.

Zudem, das Scripting.FileSystemObject ist erstens die langsamste Möglichkeit überhaupt und zweitens, da das Ganze aus der scrrun.dll kommt welche Bestandteil des Windows-Scripting ist, nicht ganz unproblematisch. Wenn eine Firma einen Scriptblocker einsetzt kann es passieren, dass die dll entweder gar nicht zur Verfügung steht oder deren Benutzung in der IT-Abteilung Alarm auslöst. Auch das versenden der Mappe per Mail könnte ein Problem werden denn verschiedene Mailfilter fischen solche Dateien raus.

Custer
10.07.2014, 08:56
Hi aloys

Danke dir nochmals für die super Hilfe.

Das Makro funktioniert nun mit dem folgenden Code:

Sub PDFErstellen()
'Schleife
Dim strOrdnerName As String
Dim StrName As String
Dim vollpfad As String
Dim intz As Integer
'PDF
Dim objDoc As Object
Dim wrdDoc As Object
Dim Dateiname As String, strFilename As String, strTempBuffer As String, Pfad As String
Dim Endung As String 'doc oder docx
Dim L_Endung As Integer 'Länge Dateityp

If Not Word_Connect Then _
Exit Sub
On Error GoTo Fehler
EreignisseAus

strOrdnerName = UserForm1.TextBox1.Value & "\"

'Abfrage ob .docx oder .doc gewählt wurde, entsprechend wir nach den mit der Endung Dateien gesucht
Endung = UserForm1.ComboBox1.Value
L_Endung = Len(Endung)
StrName = Dir(strOrdnerName & "*" & Endung)
Debug.Print UserForm1.ComboBox1.Value
UserForm1.Label5.Caption = "Konvertierung läuft, bitte warte einen Moment..."
UserForm1.Label5.Visible = True
Do While StrName <> "" And Right(StrName, L_Endung) = Endung
vollpfad = strOrdnerName & StrName
Set objDoc = CreateObject("Word.Application")
Set wrdDoc = objDoc.Documents.Open(vollpfad)
Debug.Print vollpfad
'Abfrage ob .docx oder .doc gewählt wurde (entsprechen wird doc oder docx durch PDF ersetzt
If UserForm1.ComboBox1.Value = ".docx" Then
vollpfad = Replace(vollpfad, "docx", "pdf")
Else
vollpfad = Replace(vollpfad, "doc", "pdf")
End If
Debug.Print vollpfad
wrdDoc.ExportAsFixedFormat OutputFileName:= _
vollpfad, ExportFormat:=17, _
OpenAfterExport:=False, OptimizeFor:=0, Range:= _
0, From:=1, To:=1, Item:=0, _
IncludeDocProps:=True, KeepIRM:=True, CreateBookmarks:= _
0, DocStructureTags:=True, BitmapMissingFonts:= _
True, UseISO19005_1:=False
wrdDoc.Close SaveChanges:=False
intz = intz + 1
StrName = Dir
Loop

Ich werde es dann noch ausgiebig testen, aber momentan scheint es die Lösung zu sein :)

Bei weiteren Problemen melde ich mich wieder ;)

Danke auch an dich Nepumuk, für die Erklärung.

Lg

Custer

Nepumuk
10.07.2014, 09:01
Hallo,

diese Abfrage:
Do While StrName <> "" And Right(StrName, L_Endung) = Endung
ist fatal. Du brichst nämlich die Suche nach Dateien ab sobald eine Datei mit anderer Endung kommt, dahinter können aber noch Dateien mit der richtigen Endung kommen denn die DIR-Funktion läuft die Dateien in alphabetischer Reihenfolge durch.

aloys78
10.07.2014, 09:03
Hallo Nepumuk,

danke für diese Infos aus deiner Praxis; ich weiss von diesen Funktionen bisher nur aus "Excel VBA" von Michael Schwimmer.

Gruß
Aloys

Custer
10.07.2014, 09:04
Hallo Custer,

nicht Right oder Date sind kaputt, sondern Du hast ein Verweis-Problem.

Wenn Du auf dem Office2010-Rechner entwickeln würdest, gäbe es das nicht, denn die Aufwärtskompatibilität klappt ganz gut.

Andersherum gibt es dafür aber keine Gewähr.

Solange Du keine spezifischen Office2013-Neuerungen einsetzt könntest Du auch weiterhin auf dem Office2013-Rechner entwickeln, die Verweise in den Dateien aber vor dem Verteilen an andere auf Deinem Office2010-Rechner umsetzen.

Danke für die Erklärung!

Das habe ich ebenfalls festgestellt, das es aufwärts kein Problem ist. Jedoch verstehe ich nicht, was du du mit dem folgenden Satz meinst: "[...]die Verweise in den Dateien aber vor dem Verteilen an andere auf Deinem Office2010-Rechner umsetzen."

Kannst du mir das genauer erklären? Ich bin nicht sehr erfahren was VBA anbelangt ;)


Vielen Dank!

Lg

Custer

Custer
10.07.2014, 09:09
Hallo,

diese Abfrage:
Do While StrName <> "" And Right(StrName, L_Endung) = Endung
ist fatal. Du brichst nämlich die Suche nach Dateien ab sobald eine Datei mit anderer Endung kommt, dahinter können aber noch Dateien mit der richtigen Endung kommen denn die DIR-Funktion läuft die Dateien in alphabetischer Reihenfolge durch.

Du hast Recht. Beim Test waren zufällig alle Dateien mit .doc zu Beginn. Ich hatte die Überprüfung zuerst so:

If Right(StrName, L_Endung) = Endung then

Jedoch hatte ich dann ein Problem mit der intz und der Angabe der konvertierten Dateien. Wie wäre das zu bewerkstelligen?

Hier der Code, welcher ich zuvor hatte:

Sub PDFErstellen()
'Schleife
Dim strOrdnerName As String
Dim StrName As String
Dim vollpfad As String
Dim intz As Integer
'PDF
Dim objDoc As Object
Dim wrdDoc As Object
Dim Dateiname As String, strFilename As String, strTempBuffer As String, Pfad As String
Dim Endung As String 'doc oder docx
Dim L_Endung As Integer 'Länge Dateityp

If Not Word_Connect Then _
Exit Sub
On Error GoTo Fehler
EreignisseAus

strOrdnerName = UserForm1.TextBox1.Value & "\"

'Abfrage ob .docx oder .doc gewählt wurde, entsprechend wir nach den mit der Endung Dateien gesucht
Endung = UserForm1.ComboBox1.Value
L_Endung = Len(Endung)
StrName = Dir(strOrdnerName & "*" & Endung)
Debug.Print UserForm1.ComboBox1.Value
UserForm1.Label5.Caption = "Konvertierung läuft, bitte warte einen Moment..."
UserForm1.Label5.Visible = True
Do While StrName <> ""
If Right(StrName, L_Endung) = Endung Then 'überprüft ob die Endung stimmt
vollpfad = strOrdnerName & StrName
Set objDoc = CreateObject("Word.Application")
Set wrdDoc = objDoc.Documents.Open(vollpfad)

'Abfrage ob .docx oder .doc gewählt wurde (entsprechen wird doc oder docx durch PDF ersetzt
If UserForm1.ComboBox1.Value = ".docx" Then
vollpfad = Replace(vollpfad, "docx", "pdf")
Else
vollpfad = Replace(vollpfad, "doc", "pdf")
End If

wrdDoc.ExportAsFixedFormat OutputFileName:= _
vollpfad, ExportFormat:=17, _
OpenAfterExport:=False, OptimizeFor:=0, Range:= _
0, From:=1, To:=1, Item:=0, _
IncludeDocProps:=True, KeepIRM:=True, CreateBookmarks:= _
0, DocStructureTags:=True, BitmapMissingFonts:= _
True, UseISO19005_1:=False
wrdDoc.Close SaveChanges:=False
End If '---------> END IF von Überprüfung der Endung
intz = intz + 1
StrName = Dir
Loop

Funktioniert auch die Umwandlung. Wie kann ich dann jedoch die Anz. umgewandelter Dateien ermitteln?

Lg

Custer

Nepumuk
10.07.2014, 09:20
Hallo,

du muss den Zähler einfach vor End If setzen. Zudem solltest du nicht für jedes Dokument eine neue Word-Instanz erstellen, das kostet unnötig Zeit.

Custer
10.07.2014, 09:25
Hallo,

du muss den Zähler einfach vor End If setzen. Zudem solltest du nicht für jedes Dokument eine neue Word-Instanz erstellen, das kostet unnötig Zeit.

Danke :) Ich dachte der Zähler hängt mit der Abarbeitung zusammen, aber das ist ja in diesem Fall garnicht so -.-

Ich bin sehr froh, dass du das ansprichst oO Den Code habe ich gefunden und etwas abgeändert.

Wie wäre das einfacher zu lösen? Bzw. wie verhindere ich das?

Hier ist der ganze Code zum Erstellen des PDF. Ich habe nichts ähnliches gefunden und deshalb diesen genommen. Jedoch habe ich das Gefühl, dass es viel kürzer gehen würde?

Aufgrund der vielen Instanzen die geöffnet werden, musste ich auch das WordKill einfügen. Sonst hätte es Probleme gegeben.

Hast du Verbesserungen?

Dim oWord_App As Object, oDoc As Object, bWordVorhanden As Boolean

'Unter Extras, Verweise, Verweis auf MS Word setzen!

Sub PDFErstellen()
'Schleife
Dim strOrdnerName As String
Dim StrName As String
Dim vollpfad As String
Dim intz As Integer
'PDF
Dim objDoc As Object
Dim wrdDoc As Object
Dim Dateiname As String, strFilename As String, strTempBuffer As String, Pfad As String
Dim Endung As String 'doc oder docx
Dim L_Endung As Integer 'Länge Dateityp

If Not Word_Connect Then _
Exit Sub
On Error GoTo Fehler
EreignisseAus

strOrdnerName = UserForm1.TextBox1.Value & "\"

'Abfrage ob .docx oder .doc gewählt wurde, entsprechend wir nach den mit der Endung Dateien gesucht
Endung = UserForm1.ComboBox1.Value
L_Endung = Len(Endung)
StrName = Dir(strOrdnerName & "*" & Endung)
Debug.Print UserForm1.ComboBox1.Value
UserForm1.Label5.Caption = "Konvertierung läuft, bitte warte einen Moment..."
UserForm1.Label5.Visible = True
Do While StrName <> ""
If Right(StrName, L_Endung) = Endung Then 'überprüft ob die Endung stimmt
vollpfad = strOrdnerName & StrName
Set objDoc = CreateObject("Word.Application")
Set wrdDoc = objDoc.Documents.Open(vollpfad)

'Abfrage ob .docx oder .doc gewählt wurde (entsprechen wird doc oder docx durch PDF ersetzt
If UserForm1.ComboBox1.Value = ".docx" Then
vollpfad = Replace(vollpfad, "docx", "pdf")
Else
vollpfad = Replace(vollpfad, "doc", "pdf")
End If

wrdDoc.ExportAsFixedFormat OutputFileName:= _
vollpfad, ExportFormat:=17, _
OpenAfterExport:=False, OptimizeFor:=0, Range:= _
0, From:=1, To:=1, Item:=0, _
IncludeDocProps:=True, KeepIRM:=True, CreateBookmarks:= _
0, DocStructureTags:=True, BitmapMissingFonts:= _
True, UseISO19005_1:=False
wrdDoc.Close SaveChanges:=False
intz = intz + 1
End If '---------> END IF von Überprüfung der Endung
StrName = Dir
Loop
UserForm1.Label5.Caption = "PDF-Dateien erfolgreicht erstellt." & vbLf & "Anzahl Dateien konvertiert: " & intz
Aufraeumen:
Word_Disconnect
EreignisseEin
Call Kill_Word
Exit Sub
Fehler:
MsgBox Err.Description
Resume Aufraeumen
EreignisseEin
Call Kill_Word

End Sub


Private Function Word_Connect() As Boolean
Word_Connect = True
On Error GoTo OpenError
Set oWord_App = GetObject(Class:="Word.Application")
bWordVorhanden = True
On Error GoTo 0
Exit Function
OpenError:
On Error GoTo CreateError
Set oWord_App = CreateObject(Class:="Word.Application")
oWord_App.Visible = False
bWordVorhanden = False
Resume Next
Exit Function
CreateError:
MsgBox "Kein Word vorhanden"
Word_Connect = False
End Function

Private Sub Word_Disconnect()
On Error Resume Next
Set oDoc = Nothing
oWord_App.Quit
Set oWord_App = Nothing
End Sub

Sub EreignisseAus()
With Application
.ScreenUpdating = False
.EnableEvents = False
.Calculation = xlCalculationManual
End With
End Sub

Sub EreignisseEin()
With Application
.Calculation = xlCalculationAutomatic
.EnableEvents = True
.ScreenUpdating = True
End With
End Sub

Sub Kill_Word()
'Schliesst alle offenen Word-Prozesse
Dim sKillWord As String

sKillWord = "TASKKILL /F /IM Winword.exe"

Shell sKillWord, vbHide

End Sub


Lg

Custer

Nepumuk
10.07.2014, 09:34
Hallo,

indem du das erzeugen der Word-Instanz vor der Schleife machst und nach der Schleife diese Instanz mit objDoc.Quit wieder schließt.

Schau mal in deinen Taskmanager, da hast du wahrscheinlich noch duzende Instanzen von Word offen. Mach die mal alle zu.

haklesoft
10.07.2014, 09:39
Das habe ich ebenfalls festgestellt, das es aufwärts kein Problem ist. Jedoch verstehe ich nicht, was du du mit dem folgenden Satz meinst: "[...]die Verweise in den Dateien aber vor dem Verteilen an andere auf Deinem Office2010-Rechner umsetzen."

Kannst du mir das genauer erklären?Hallo Custer,

wenn Deine Entwicklung mit Office2013 fertig ist, öffnest Du die Datei auf Deinem Office2010-Rechner.
Per [Alt+F11] wechselst Du zum VBA-Projekteditor. Dort unter "Extras" auf "Verweise..." klicken.

Alle angehakten Verweise, in denen etwas von 15.0 steht musst Du deaktivieren und in der Auflistung die jeweilige 14.0-Variante suchen und aktivieren.

Anschließend unter "Debuggen" "Kompilieren von VBA-Projekt" ausführen und wenn es keine Fehler gab das Projekt speichern.

haklesoft
10.07.2014, 09:45
indem du das erzeugen der Word-Instanz vor der Schleife machst und nach der Schleife diese Instanz mit objDoc.Quit wieder schließt.

Schau mal in deinen Taskmanager, da hast du wahrscheinlich noch dutzende Instanzen von Word offen.Hallo Nepumuk,

auf solche Art erzeugte Word-Instanzen lassen sich mit .Quit nicht zuverlässig aus dem Speicher entfernen. Es bleiben Fragmente erhalten, die zu unerklärlichen Word-Problemen führen können. Das ist schon seit Word97 so. Abhilfe: man kapselt das Word-Objekt in einer Klasse. Sobald die Klasse selbst terminiert, wird auch das darin geladene Word restlos entfernt.

Custer
10.07.2014, 09:45
Hallo,

indem du das erzeugen der Word-Instanz vor der Schleife machst und nach der Schleife diese Instanz mit objDoc.Quit wieder schließt.

Schau mal in deinen Taskmanager, da hast du wahrscheinlich noch duzende Instanzen von Word offen. Mach die mal alle zu.

Genau dieses Problem hatte ich, deshalb das KillWord ;)

Nun mein Code:

Sub PDFErstellen()
'Schleife
Dim strOrdnerName As String
Dim StrName As String
Dim vollpfad As String
Dim intz As Integer
'PDF
Dim objDoc As Object
Dim wrdDoc As Object
Dim Dateiname As String, strFilename As String, strTempBuffer As String, Pfad As String
Dim Endung As String 'doc oder docx
Dim L_Endung As Integer 'Länge Dateityp

If Not Word_Connect Then _
Exit Sub
On Error GoTo Fehler
EreignisseAus

strOrdnerName = UserForm1.TextBox1.Value & "\"

'Abfrage ob .docx oder .doc gewählt wurde, entsprechend wir nach den mit der Endung Dateien gesucht
Endung = UserForm1.ComboBox1.Value
L_Endung = Len(Endung)
StrName = Dir(strOrdnerName & "*" & Endung)
Debug.Print UserForm1.ComboBox1.Value
UserForm1.Label5.Caption = "Konvertierung läuft, bitte warte einen Moment..."
UserForm1.Label5.Visible = True

Set objDoc = CreateObject("Word.Application")

Do While StrName <> ""
If Right(StrName, L_Endung) = Endung Then 'überprüft ob die Endung stimmt
vollpfad = strOrdnerName & StrName
'Set objDoc = CreateObject("Word.Application")
Set wrdDoc = objDoc.Documents.Open(vollpfad)

'Abfrage ob .docx oder .doc gewählt wurde (entsprechen wird doc oder docx durch PDF ersetzt
If UserForm1.ComboBox1.Value = ".docx" Then
vollpfad = Replace(vollpfad, "docx", "pdf")
Else
vollpfad = Replace(vollpfad, "doc", "pdf")
End If

wrdDoc.ExportAsFixedFormat OutputFileName:= _
vollpfad, ExportFormat:=17, _
OpenAfterExport:=False, OptimizeFor:=0, Range:= _
0, From:=1, To:=1, Item:=0, _
IncludeDocProps:=True, KeepIRM:=True, CreateBookmarks:= _
0, DocStructureTags:=True, BitmapMissingFonts:= _
True, UseISO19005_1:=False
wrdDoc.Close SaveChanges:=False
intz = intz + 1
End If '---------> END IF von Überprüfung der Endung
StrName = Dir
Loop
objDoc.Quit
UserForm1.Label5.Caption = "PDF-Dateien erfolgreicht erstellt." & vbLf & "Anzahl Dateien konvertiert: " & intz
Aufraeumen:
Word_Disconnect
EreignisseEin
Call Kill_Word
Exit Sub
Fehler:
MsgBox Err.Description
Resume Aufraeumen
EreignisseEin
Call Kill_Word

End Sub

Die Konvertierung läuft x-Mal schneller, vielen Dank!

Stimmt so, oder?

@haklesoft: Besten Dank noch für die Erklärung bezüglich der Verweise :top:

lg

Custer

Nepumuk
10.07.2014, 09:58
Hallo,

das:
If UserForm1.ComboBox1.Value = ".docx" Then
vollpfad = Replace(vollpfad, "docx", "pdf")
Else
vollpfad = Replace(vollpfad, "doc", "pdf")
End If
würde ich anders machen.


Vor der Schleife:
Dim strReplace As String

strReplace = Mid$(UserForm1.ComboBox1.Value, 2)
In der Schleife, an Stelle deiner Abfrage, das:
vollpfad = Replace(vollpfad, strReplace, "pdf")
Damit hast du nur eine Abfrage deiner Combobox für alle Dokumente.

Ansonsten ist es ok.


Zu den Verweisen möchte ich aber noch was anmerken:

Verweise sind in 99% aller Fälle vollkommen überflüssig. Nur bei OCX-Dateien welche eigene Events mit eigenen Datentypen als Parameter mitbringen sind diese zwingend notwendig.

Custer
10.07.2014, 10:18
Danke!

Ich kann dir nicht ganz folgen bezüglich der Funktion:

strReplace = Mid$(UserForm1.ComboBox1.Value, 2)

Was gibt mir Mid$ zurück und wofür steht die 2 nach dem Komma?

Hab ich noch nie verwendet ;)

Ich möchte das ganze noch um die Funktion erweitern, dass .docx und .doc gleichzeitig konvertiert werden können. Würdest du das dann immernoch so machen? In diesem Fall wäre z.B. der ComboBox Eintrag: "beide"

lg

Custer

Nepumuk
10.07.2014, 10:33
Hallo,

Mid ist eine Funktion welche einen bestimmten Teil eines Strings zurück gibt bzw. schreibt. Die 2 sagt, dass ich von dem Wert in der Combobox alles außer der ersten Stelle (den Punkt vor der Endung) im der Variablen strReplace haben will. Setz einfach mal den Cursor in das Work Mid und drück auf F1. VBA hat eine sehr umfangreiche Hilfe.

Es gibt von dieser und anderen String-Methoden (Left, Right, Space ....) zwei Varianten. Die mit $-Zeichen und die ohne. Also Mid$ und Mid, Left$ und Left ..... Einfach mal im Objektkatalog nach Strings suchen

Der Unterschied: Mid$ gibt einen reinen String zurück. Mid einen Variant vom Untertyp String. Ein Variant benötigt erheblich mehr Speicher und ist daher etwas langsamer ein String.


Wenn du beide Dateitypen exportieren willst, musst du das Ganze anders aufziehen. Aber jetzt hab ich erst mal Hunger.

Custer
10.07.2014, 10:38
Danke Nepumuk :)

Ich wünsche guten Appetit!

Lg

Custer

Custer
10.07.2014, 12:05
Hallo Custer,

wenn Deine Entwicklung mit Office2013 fertig ist, öffnest Du die Datei auf Deinem Office2010-Rechner.
Per [Alt+F11] wechselst Du zum VBA-Projekteditor. Dort unter "Extras" auf "Verweise..." klicken.

Alle angehakten Verweise, in denen etwas von 15.0 steht musst Du deaktivieren und in der Auflistung die jeweilige 14.0-Variante suchen und aktivieren.

Anschließend unter "Debuggen" "Kompilieren von VBA-Projekt" ausführen und wenn es keine Fehler gab das Projekt speichern.

Ich habe das nun so gemacht, jedoch kommt beim Starten immernoch eine Fehlermeldung, bzw. eine neue:

Private Sub Workbook_open()

With Tabelle1

.Unprotect Password:="Wartung"
.ScrollArea = "A1:K25"
'ActiveWindow.DisplayGridlines = True
'.Cells(2, 10).Value = WeekdayName(Weekday(Date, vbMonday)) & ", " & Date
'.Cells(2, 3).Value = Environ("Username")
'.Cells(2, 7).Value = Environ("Computername")
'Gitternetzlinien ausblenden
'Bei allen Zellen im Bereich die Funktion "Geschützt" aktivieren
.Range("A1:K25").Locked = True
'Schutz aktivieren
.Protect Password:="Wartung"
End With

Es sagt mir bezüglich ActiveWindows.DisplayGridLines = True

Objektvariable oder With-Objekt nicht definiert.

Weshalb?

Wenn ich das lösche, geht alles perfekt. Beim Kompilieren erhalte ich kein Fehler.

Lg

Custer

Nepumuk
10.07.2014, 12:36
Hallo,

teste mal:

<nobr><span style="font-family:Courier New,Arial; font-size:9pt ;" ><span style="color:#000080"; >Option</span> <span style="color:#000080"; >Explicit</span><br /><br /><b><span style="color:#000080"; >Public</span> <span style="color:#000080"; >Sub</span> CreatePDF()</b><br />&nbsp;&nbsp;&nbsp;&nbsp;<br />&nbsp;&nbsp;&nbsp;&nbsp;<span style="color:#000080"; >Const</span> PDF_EXTENSION <span style="color:#000080"; >As</span> <span style="color:#000080"; >String</span> = <span style="color:#800000"; >"pdf"</span><br />&nbsp;&nbsp;&nbsp;&nbsp;<br />&nbsp;&nbsp;&nbsp;&nbsp;<span style="color:#000080"; >Dim</span> astrFiles() <span style="color:#000080"; >As</span> String, strFolder <span style="color:#000080"; >As</span> String, strPdfPath <span style="color:#000080"; >As</span> <span style="color:#000080"; >String</span><br />&nbsp;&nbsp;&nbsp;&nbsp;<span style="color:#000080"; >Dim</span> ialngCounter <span style="color:#000080"; >As</span> Long, ialngIndex <span style="color:#000080"; >As</span> <span style="color:#000080"; >Long</span><br />&nbsp;&nbsp;&nbsp;&nbsp;<span style="color:#000080"; >Dim</span> objWord <span style="color:#000080"; >As</span> Object, objDocument <span style="color:#000080"; >As</span> <span style="color:#000080"; >Object</span><br />&nbsp;&nbsp;&nbsp;&nbsp;<br />&nbsp;&nbsp;&nbsp;&nbsp;strFolder = UserForm1.TextBox1.Text & <span style="color:#800000"; >"\"</span><br />&nbsp;&nbsp;&nbsp;&nbsp;<br />&nbsp;&nbsp;&nbsp;&nbsp;<span style="color:#000080"; >Select</span> <span style="color:#000080"; >Case</span> UserForm1.ComboBox1.Text<br />&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<span style="color:#000080"; >Case</span> <span style="color:#800000"; >".doc"</span><br />&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<span style="color:#000080"; >Call</span> SearchFiles(astrFiles, ialngCounter, strFolder, <span style="color:#800000"; >".doc"</span>)<br />&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<span style="color:#000080"; >Case</span> <span style="color:#800000"; >".docx"</span><br />&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<span style="color:#000080"; >Call</span> SearchFiles(astrFiles, ialngCounter, strFolder, <span style="color:#800000"; >".docx"</span>)<br />&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<span style="color:#000080"; >Case</span> <span style="color:#000080"; >Else</span><br />&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<span style="color:#000080"; >Call</span> SearchFiles(astrFiles, ialngCounter, strFolder, <span style="color:#800000"; >".doc"</span>)<br />&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<span style="color:#000080"; >Call</span> SearchFiles(astrFiles, ialngCounter, strFolder, <span style="color:#800000"; >".docx"</span>)<br />&nbsp;&nbsp;&nbsp;&nbsp;<span style="color:#000080"; >End</span> <span style="color:#000080"; >Select</span><br />&nbsp;&nbsp;&nbsp;&nbsp;<br />&nbsp;&nbsp;&nbsp;&nbsp;<span style="color:#000080"; >If</span> ialngCounter &gt; 0 <span style="color:#000080"; >Then</span><br />&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<br />&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<span style="color:#000080"; >Set</span> objWord = CreateObject(<span style="color:#800000"; >"Word.Application"</span>)<br />&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<br />&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<span style="color:#000080"; >For</span> ialngIndex = <span style="color:#000080"; >LBound</span>(astrFiles) <span style="color:#000080"; >To</span> <span style="color:#000080"; >UBound</span>(astrFiles)<br />&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<br />&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;strPdfPath = Left$(astrFiles(ialngIndex), _<br />&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;InStrRev(astrFiles(ialngIndex), <span style="color:#800000"; >"."</span>)) & PDF_EXTENSION<br />&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<br />&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<span style="color:#000080"; >Set</span> objDocument = objWord.Documents.Open(astrFiles(ialngIndex))<br />&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<br />&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;objDocument.ExportAsFixedFormat _<br />&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;OutputFileName:=strPdfPath, ExportFormat:=17, _<br />&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;OpenAfterExport:=False, OptimizeFor:=0, _<br />&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;Range:=0, From:=1, To:=1, Item:=0, _<br />&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;IncludeDocProps:=True, KeepIRM:=True, _<br />&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;CreateBookmarks:=0, DocStructureTags:=True, _<br />&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;BitmapMissingFonts:=True, UseISO19005_1:=False<br />&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<br />&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;objDocument.Close SaveChanges:=False<br />&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<br />&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<span style="color:#000080"; >Set</span> objDocument = <span style="color:#000080"; >Nothing</span><br />&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<br />&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<span style="color:#000080"; >Next</span><br />&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<br />&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;objWord.Quit<br />&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<br />&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<span style="color:#000080"; >Set</span> objWord = <span style="color:#000080"; >Nothing</span><br />&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<br />&nbsp;&nbsp;&nbsp;&nbsp;<span style="color:#000080"; >Else</span><br />&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;MsgBox <span style="color:#800000"; >"Keine Dateien gefunden."</span>, vbExclamation, <span style="color:#800000"; >"Hinweis"</span><br />&nbsp;&nbsp;&nbsp;&nbsp;<span style="color:#000080"; >End</span> <span style="color:#000080"; >If</span><br /><b><span style="color:#000080"; >End</span> <span style="color:#000080"; >Sub</span></b><br /><br /><b><span style="color:#000080"; >Private</span> <span style="color:#000080"; >Sub</span> SearchFiles( _<br />&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<span style="color:#000080"; >ByRef</span> prastrFiles() <span style="color:#000080"; >As</span> String, _<br />&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<span style="color:#000080"; >ByRef</span> prialngCounter <span style="color:#000080"; >As</span> Long, _<br />&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<span style="color:#000080"; >ByVal</span> pvstrFolder <span style="color:#000080"; >As</span> String, _<br />&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<span style="color:#000080"; >ByVal</span> pvstrExtension <span style="color:#000080"; >As</span> <span style="color:#000080"; >String</span>)</b><br />&nbsp;&nbsp;&nbsp;&nbsp;<br />&nbsp;&nbsp;&nbsp;&nbsp;<span style="color:#000080"; >Dim</span> strFilename <span style="color:#000080"; >As</span> <span style="color:#000080"; >String</span><br />&nbsp;&nbsp;&nbsp;&nbsp;<span style="color:#000080"; >Dim</span> lngExtensionLength <span style="color:#000080"; >As</span> <span style="color:#000080"; >Long</span><br />&nbsp;&nbsp;&nbsp;&nbsp;<br />&nbsp;&nbsp;&nbsp;&nbsp;lngExtensionLength = Len(pvstrExtension)<br />&nbsp;&nbsp;&nbsp;&nbsp;<br />&nbsp;&nbsp;&nbsp;&nbsp;strFilename = Dir$(pvstrFolder & <span style="color:#800000"; >"*"</span> & pvstrExtension)<br />&nbsp;&nbsp;&nbsp;&nbsp;<br />&nbsp;&nbsp;&nbsp;&nbsp;<span style="color:#000080"; >Do</span> <span style="color:#000080"; >Until</span> strFilename = vbNullString<br />&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<br />&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<span style="color:#000080"; >If</span> Right$(strFilename, lngExtensionLength) = pvstrExtension <span style="color:#000080"; >Then</span><br />&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<br />&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<span style="color:#000080"; >Redim</span> <span style="color:#000080"; >Preserve</span> prastrFiles(prialngCounter)<br />&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<br />&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;prastrFiles(prialngCounter) = pvstrFolder & strFilename<br />&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<br />&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;prialngCounter = prialngCounter + 1<br />&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<br />&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<span style="color:#000080"; >End</span> <span style="color:#000080"; >If</span><br />&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<br />&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;strFilename = Dir$<br />&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<br />&nbsp;&nbsp;&nbsp;&nbsp;<span style="color:#000080"; >Loop</span><br /><b><span style="color:#000080"; >End</span> <span style="color:#000080"; >Sub</span></b><br /></span></nobr>

Custer
10.07.2014, 15:33
Hallo Nepumuk

Danke für den Code, aber da blicke ich gar nicht mehr durch xD

----->@Nepumuk: Makro funktioniert einwandfrei! Scheint sauberer zu laufen, weder das ursprüngliche<-----

Weshalb empfiehlst du mir diesen Code? Bzw. arbeitet er anders? Was ist der Unterschied zum Prinzip meines Ursprungscodes?

Ich frage das nicht, weil ich an deinem Code zweifeln könnte, sondern um möglichst viel zu lernen und diesen evtl. etwas besser zu verstehen.

Die Fehlermeldung, von welcher ich berichtete, bezieht sich auf die Einstellung, die Gitternetzlinien auszublenden. Weshalb bekomme ich diese?

Lg

Custer

haklesoft
10.07.2014, 15:41
Es sagt mir bezüglich ActiveWindows.DisplayGridLines = True

Objektvariable oder With-Objekt nicht definiert.Ist vielleicht ein Timingproblem. Setzt die Zeile mal ans Ende der Routine und ggf. ein DoEvents davor.

Custer
10.07.2014, 16:07
Ist vielleicht ein Timingproblem. Setzt die Zeile mal ans Ende der Routine und ggf. ein DoEvents davor.

Werde ich testen, danke :)

Lg

Custer

Custer
10.07.2014, 17:04
Werde ich testen, danke :)

Lg

Custer

@haklesoft: bringt leider keinerlei Änderung, obwohl am Ende und mit DoEvents zuvor, immernoch dieselbe Meldung

lg

Custer

Nepumuk
10.07.2014, 18:34
Hallo,

bitte keine Rundumschlagfrage sondern gezielte.

Der größte Unterschied, die Suche nach den entsprechenden Dateien ist in eine eigene Prozedur ausgelagert. Damit ist es möglich entweder nach doc, docx oder beiden zu suchen. Das ging mit deiner Routine nicht.