Dieses Forum nutzt Cookies
Dieses Forum verwendet Cookies, um deine Login-Informationen zu speichern, wenn du registriert bist, und deinen letzten Besuch, wenn du es nicht bist. Cookies sind kleine Textdokumente, die auf deinem Computer gespeichert werden. Die von diesem Forum gesetzten Cookies werden nur auf dieser Website verwendet und stellen kein Sicherheitsrisiko dar. Cookies aus diesem Forum speichern auch die spezifischen Themen, die du gelesen hast und wann du zum letzten Mal gelesen hast. Bitte bestätige, ob du diese Cookies akzeptierst oder ablehnst.

Ein Cookie wird in deinem Browser unabhängig von der Wahl gespeichert, um zu verhindern, dass dir diese Frage erneut gestellt wird. Du kannst deine Cookie-Einstellungen jederzeit über den Link in der Fußzeile ändern.

Dokumenteigenschaften auslesen dauert
#1
Hallo,

ich lese aus ca 300 Dateien die Dokumenteigenschaften aus, was leider pro Dokument ein paar Sekunden dauert, was sich addiert. Der Code ist folgender:


Code:
Dateiname = Dir("\\server\*.doc*")

Do While Dateiname <> ""

strDateiname = "\\server\" & Dateiname & ""
Set objDatei = GetObject(strDateiname)
Set dp = objDatei.ContentTypeProperties
ThisWorkbook.Worksheets("Dokumentenbibliothek").Range("b" & letzteZeile_excel_DB + 1).Offset(i, 0) = dp("User / Support")
i = i + 1
Dateiname = Dir$()
Loop


Ich konnte herausfinden, dass die Zeile "Set objDatei = GetObject(strDateiname)"
diejenige ist, die so lange braucht zum Ausführen.
Kann man das irgendwie eleganter lösen?
Vielen Dank und Gruß!
Antworten Top
#2
Hallo,

bleibt die Zeit zum Ausführen immer gleich oder dauert es von Datei zu Datei immer länger? Wenn das zweite der Fall ist, setze die Variablen auf Nothing.

PHP-Code:
Dateiname Dir("\\server\*.doc*")

Do While 
Dateiname <> ""

strDateiname "\\server\" & Dateiname & ""
Set objDatei = GetObject(strDateiname)
Set dp = objDatei.ContentTypeProperties
ThisWorkbook.Worksheets("
Dokumentenbibliothek").Range("b" & letzteZeile_excel_DB + 1).Offset(i, 0) = dp("User Support")
i = i + 1
Set dp = Nothing
Set objDatei = Nothing
Dateiname = Dir$()
Loop 
Gruß Stefan
Win 10 / Office 2016
Antworten Top
#3
Hallo Stefan,

danke erstmal für den Hinweis.
Leider dauert es immer gleichlang, auch beim ersten Durchlauf des Loops.

Gruß
Antworten Top
#4
Hallo,

mal ungetestet

Code:
Sub prcX()
   Dim objWord As Object, objDatei As Object, dp As Object
   Dim strDateiname As String
   Dim i As Long
   
   Set objWord = GetObject(, "Word.Application")
   
   Dateiname = Dir("\\server\*.doc*")
   
   Do While Dateiname <> ""
       
       strDateiname = "\\server\" & Dateiname & ""
       Set objDatei = objWord.documents.Open(strDateiname)
       Set dp = objDatei.ContentTypeProperties
       ThisWorkbook.Worksheets("Dokumentenbibliothek").Range("b" & letzteZeile_excel_DB + 1).Offset(i, 0) = dp("User / Support")
       i = i + 1
       objDatei.activedocument.Close False
       objDatei.Quit
       objDatei = Nothing
       Dateiname = Dir$()
   Loop
   objWord = Nothing

End Sub
Gruß Stefan
Win 10 / Office 2016
Antworten Top
#5
Damit bekomme ich leider in der Zeile
Code:
Set objWord = GetObject(, "Word.Application")
den Laufzeitfehler "Objekterstellung durch ActiveX Komponente nicht möglich"
Antworten Top
#6
Hallo,

beim ersten Lauf im Einzelschrittmodus gab es bei mir diesen Fehler auch. Danach nicht mehr  Huh
Ich habe keine Ahnung weshalb und konnte deshalb meine Codeänderung nicht testen (zumindest den Teil mit der Verbindung zu Word).

Code:
Sub prcX()
   Dim objWord As Object, objDatei As Object, dp As Object
   Dim strDateiname As String
   Dim i As Long
   
   On Error GoTo errHandling
   Set objWord = GetObject(class:="Word.Application")
   On Error GoTo 0
   Dateiname = Dir("\\server\*.doc*")
   
   Do While Dateiname <> ""
       
       strDateiname = "\\server\" & Dateiname & ""
       Set objDatei = objWord.Documents.Open(strDateiname)
       Set dp = objDatei.ContentTypeProperties
       ThisWorkbook.Worksheets("Dokumentenbibliothek").Range("b" & letzteZeile_excel_DB + 1).Offset(i, 0) = dp("User / Support")
       i = i + 1
       objDatei.activedocument.Close False
       objDatei.Quit
       objDatei = Nothing
       Dateiname = Dir$()
   Loop
   objWord = Nothing
   Exit Sub
errHandling:
   Set objWord = CreateObject("Word.Application")
   Resume
End Sub
Gruß Stefan
Win 10 / Office 2016
Antworten Top
#7
Das is wirklich komisch, nach weiteren Durchläufen führt er den Code tatsächlich aus.

Nur leider erzielt das auch nicht die gewünschte Wirkung.
Das Öffnen des Dokuments dauert leider genau so lange :(

Gruß
Antworten Top
#8
Hallo,

tut mir leid, dann werfe ich das Handtuch.
Gruß Stefan
Win 10 / Office 2016
Antworten Top
#9
Moin,

lege doch einfach einmal zum Test einige der Files lokal ab. Dauert es ann auch so lange, oder ist das Netzwerk die Engstelle im Flaschenhals?
Beste Grüße
  Günther

Excel-ist-sexy.de
  …schau doch mal rein!
Der Sicherheit meiner Daten wegen lade ich keine *.xlsm bzw. *.xlsb- Files mehr herunter! -> So geht's ohne!
Antworten Top
#10
Hallo,

leider habe ich das auch schon versucht und es brachte keinen Erfolg...


Gruß
Antworten Top


Gehe zu:


Benutzer, die gerade dieses Thema anschauen: 1 Gast/Gäste