Author per Script ändern?

hitrugal · 21.06.2005

Hi,

ich habe gerade in einer Firma neu angefangen, und habe
die tolle Aufgabe die 300000 Dokumente meines Vorgängers
in den Eigenschaften so umzubenennen, dass nicht mehr sein
Name als Author da steht sondern meiner! Problem ist, dass
es extrem viele sind, und nun meine Frage, ob es möglich ist
viele Dokumente meinetwegen per Skript zu verändern?
Es handelt sich um Word und Excel Dokumente, ich glaub ein paar
Powerpoint sind auch dabei! Bitte haltet mir keine predigt, ich
hab das ganze mit unserem Geschäftsführer durchgesprochen,
es handelt sich nicht um Dinge die der andere geschaffen hat, sondern
eher allgemeine Geschäftsinfos!

Vielen Dank!

greetz

hitrugal

Matjes · 21.06.2005

Hi hitrugal,

noch ein paar Fragen:

- haben die Dokumente teilweise einen Schreibschutz ?

- wie soll ein Makro die Dateien finden ? (ein / mehrere Wurzeln/Verzeichnisse)

- Protokoll schreiben und wohin ?

Gruß Matjes

hitrugal · 21.06.2005

Hi,

ich weiß es ehrlich gesagt nicht, ob schreibgeschützte Dokumente dabei
sind, ich gehe erstmal davon aus, dass keine dabei sind!
Was wäre denn, wenn schreibgeschützte Dokumente dabei sind?
Geht das dann nicht, oder muß ich erst aus allen Dokumenten den
Schreibschutz rausnehmen?

Ich habe ein Verzeichnis, indem alle Dokumente gespeichert sind!
C:\Dokumente

Weiß zwar nicht wirklich was Du mit Protokoll meintst, aber wenn es sinnvoll ist, dann kann dieses Protokoll direkt auf c:\ gespeichert werden!

greetz

Hitrugal

Matjes · 21.06.2005

hi hitrugal,

wenn ein Dokument schreibgeschützt ist braucht man zum Ändern ein Passwort. Dieses müßte beim Öffnen dieser Dateien mit angegebene werden.

bzgl. Protokoll:
Ist es notwendig die Änderungen / Fehler zu protokollieren, oder kommt das nicht so drauf an ?

Gruß Matjes

hitrugal · 21.06.2005

Hi,

soweit ich weiß ist keines der Dokumente mit einem Passwort versehen!
Das Protokoll scheint auch sinnvoll zu sein, nur wie funktioniert der
Hase jetzt?

greetz

hitrugal

Matjes · 21.06.2005

Hallo hitrugal,

nun erstmal die Excel-Version um in Excel-Mappen den Author zu ändern.

Bitte passe die Konstanten entsprechend deinen bedürfnissen an.

Gruß Matjes

ps: Word folgt demnächst ..., Powerpoint müßtest du selbst kreieren, da ich im Augenblick keine geeignete Umgebung habe.

Code:

Option Explicit

'Const c_WurzelPfad = c:\Test
Const c_WurzelPfad = c:\Dokumente
Const c_NameNeuerAuthor = ich nicht
Const c_Protokolldatei = c:\Excel_ProtokollAuthorChange.txt

Sub AuthorAendern()
-> In allen Excel-Mappen im Verzeichnis c_WurzelPfad
-> und seinen Unterverzeichnissen wird der Author
-> entsprechend der konstanten c_NameNeuerAuthor
-> gesetzt.


 Dim wb As Workbook, h As Integer, x As Long
 
->Prüfen, ob alle Mappen geschlossen sind
 If Workbooks.Count > 1 Then
  MsgBox ( _
   Bitte schliessen Sie alle Arbeitsmappen, &amp; vbLf &amp; _
   bis auf die Arbeitsmappe mit diesem Makro.)
  GoTo Aufraeumen
 End If
 
->prüfen, ob Wurzelverzeichnis existiert
 If  = Dir(c_WurzelPfad &amp; \, vbDirectory) Then
  MsgBox (Wurzelverzeichnis existiert nicht.)
  GoTo Aufraeumen
 End If
 
->für alle Excel-Arbeitsmappen im Pfad
 With Application.FileSearch
   .NewSearch
   .LookIn = c_WurzelPfad
   .SearchSubFolders = True
   .FileType = msoFileTypeExcelWorkbooks
   If .Execute() > 0 Then
    
   ->Protokolldatei öffnen
    h = FreeFile
    Open c_Protokolldatei For Append Access Write As #h
    Write #h, String(50, =)
    Write #h, (Protokoll AuthorChange vom  &amp; Now())
    Write #h, String(50, =)

    On Error Resume Next
    For x = 1 To .FoundFiles.Count
     Application.StatusBar = .FoundFiles.Count &amp;  /  &amp; x
     
    ->Datei öffnen
     Set wb = Workbooks.Open(FileName:=.FoundFiles(x))
     If Err.Number = 0 Then
      If LCase(Right(.FoundFiles(x), 3)) = xls Then
      ->Author ändern
       wb.BuiltinDocumentProperties(Author).Value = c_NameNeuerAuthor
      ->Datei schliessen
       wb.Close savechanges:=True
      ->positiven Eintrag in Protokolldatei
       Write #h, (POSITIV  &amp; .FoundFiles(x))
      End If
     Else
      Err.Clear
      Write #h, (NEGATIV  &amp; .FoundFiles(x))
     End If
    
    Next x
    On Error GoTo 0
   ->Protokolldatei schliessen
    Close #h
   Else
    MsgBox Keine Datei gefunden.
   End If
 End With
 Application.StatusBar = 
Aufraeumen:
 Set wb = Nothing
End Sub

Matjes · 21.06.2005

so und nun auch die Word-Version.

Gruß Matjes

Code:

Option Explicit

Const c_WurzelPfad = c:\Test
'Const c_WurzelPfad = c:\Dokumente
Const c_NameNeuerAuthor = ich nicht
Const c_Protokolldatei = c:\Word_ProtokollAuthorChange.txt

Sub AuthorAendern()
 -> In allen Word-Dokumneten im Verzeichnis c_WurzelPfad
 -> und seinen Unterverzeichnissen wird der Author
 -> entsprechend der konstanten c_NameNeuerAuthor
 -> gesetzt.


  Dim doc As Document, h As Integer, x As Long
  
 ->Prüfen, ob alle Mappen geschlossen sind
  If Documents.Count > 1 Then
    MsgBox ( _
      Bitte schliessen Sie alle Dokumente, &amp; vbLf &amp; _
      bis auf das Dokument mit diesem Makro.)
    GoTo Aufraeumen
  End If
  
 ->prüfen, ob Wurzelverzeichnis existiert
  If  = Dir(c_WurzelPfad &amp; \, vbDirectory) Then
    MsgBox (Wurzelverzeichnis existiert nicht.)
    GoTo Aufraeumen
  End If
  
 ->für alle Dokumente im Pfad
  With Application.FileSearch
      .NewSearch
      .LookIn = c_WurzelPfad
      .SearchSubFolders = True
      .FileType = msoFileTypeWordDocuments
      If .Execute() > 0 Then
        
       ->Protokolldatei öffnen
        h = FreeFile
        Open c_Protokolldatei For Append Access Write As #h
        Write #h, String(50, =)
        Write #h, (Protokoll AuthorChange vom  &amp; Now())
        Write #h, String(50, =)

        On Error Resume Next
        For x = 1 To .FoundFiles.Count
          Application.StatusBar = .FoundFiles.Count &amp;  /  &amp; x
          
         ->Datei öffnen
          Set doc = Documents.Open(FileName:=.FoundFiles(x))
          If Err.Number = 0 Then
            If LCase(Right(.FoundFiles(x), 3)) = doc Then
             ->Author ändern
              doc.BuiltInDocumentProperties(Author).Value = c_NameNeuerAuthor
             ->Datei schliessen
              doc.Close savechanges:=True
             ->positiven Eintrag in Protokolldatei
              Write #h, (POSITIV  &amp; .FoundFiles(x))
            End If
          Else
            Err.Clear
            Write #h, (NEGATIV  &amp; .FoundFiles(x))
          End If
        
        Next x
        On Error GoTo 0
       ->Protokolldatei schliessen
        Close #h
      Else
        MsgBox Keine Datei gefunden.
      End If
  End With
  Application.StatusBar = 
Aufraeumen:
  Set doc = Nothing
End Sub

hitrugal · 22.06.2005

Hi,

Sauber! Besten Dank!
*applaus*
*niederknie*

greetz

hitrugal

Author per Script ändern?

hitrugal

Matjes

hitrugal

Matjes

hitrugal

Matjes

Matjes

hitrugal

Author per Script ändern?

ANGEBOTE & SPONSOREN

Neueste Themen

Statistik des Forums