VBA: Macro der angiver password for en masse worddokumenter

Jeg ville..

Bruge en filelistbox ...
Path = stien til filerne
Pattern = *.doc

Så ville jeg

Set oDoc = CreateObject(Class:="Word.Document")
Set docApp = CreateObject(Class:="Word.Application")

For ni = 0 to file1.listcount
    Set oDoc = docApp.Documents.Open(App.Path & file1.list(ni))
    DocApp.ActiveDocument.SaveAs WritePassword:=”Password”
    DocApp.ActiveDocument.close
Next ni

Prøv dette

Jeg tror nu du skal have fil navnet med igen og skal sikkert lave noget for at den ikke spørger om du vil overskrive ....
DocApp.ActiveDocument.SaveAs file1.list(ni) WritePassword:=”Password”

Jeg er villig til at forhøje til 45 pts hvis du lige smider et par linier ind i løkken, der:

Sørger for at den aktuelle fil bliver gemt under samme navn
Sørger for at man ikke skal sige ja til at overskrive - men at dette gøres uden at blive spurgt...

Ellers tak indtil videre.. /Martin

DocApp.ActiveDocument.WritePassword = "Password"
DocApp.ActiveDocument.Save file1.list(ni),False

Så skulle den ged været sat i bås..

Øhhh - jeg får det ikke til at virke. Selvom det jo ser meget rigtigt ud...

Jeg laver det i VB (ikke VBA), hvor jeg på en form placere en DirListBox (Dir1) og en FileListBox (File1) samt en TextBox (Text1) - samt en knap.

Når jeg trykker på command1, eksekveres følgende:

Dim ni As Integer
Dim Sti As String
Dim oDoc As Object
Dim DocApp As Object
Set oDoc = CreateObject(Class:="Word.Document")
Set DocApp = CreateObject(Class:="Word.Application")

For ni = 0 To File1.ListCount - 1
    Sti = Dir1.Path & "\" & File1.List(ni)
    Set oDoc = DocApp.Documents.Open(Sti)
    DocApp.ActiveDocument.WritePassword = Trim(Text1.Text)
    DocApp.ActiveDocument.Save File1.List(ni), False 'Denne linie giver Type Mismacth
    DocApp.ActiveDocument.Close
Next ni

Ovenstående giver fejl - se kommentaren!
Skriver jeg blot DocApp.ActiveDocument.Save (og dropper "File1.List(ni)") får jeg ingen fejl, men der bliver ikke angivet et password...

Der ER tjekket, at f.eks. Sti indeholder det den skal, og at text1 er udfyldt. Kan du klare den, vanker der måske lidt yderligere points! /Martin

SÅ har jeg fundet løsningen ..
Fjern linier
DocApp.ActiveDocument.WritePassword = Trim(Text1.Text)
DocApp.ActiveDocument.Save File1.List(ni), False 'Denne linie giver Type Mismacth

Og skriv
DocApp.ActiveDocument.saveas FileName:=File1.List(ni) WritePassword:=trim(Text1.Text)

Hvis der er password på dokumentet, skal dette tilføjes for at du kan ændre det.
DocApp.ActiveDocument.saveas FileName:=File1.List(ni) Password:=OldPassWord WritePassword:=trim(Text1.Text)

Lige en bemærkning..
Når du bruger saveas og har samme filnavn, så bliver du ikke spurgt.
Hvis det er et nyt filnavn, så bliver du spurgt..

FileName  Optional Variant. The name for the document. The default is the current folder and file name. If the document has never been saved, the default name is used (for example, Doc1.doc). If a document with the specified FileName already exists, the document is overwritten without the user being prompted first.

Fejl:
Expected: End of statement
efter
DocApp.ActiveDocument.saveas FileName:=File1.List(ni) ....
Dvs. den vil ikke æde flere parametre end filename... I øvrigt ændrede jeg := til =, men samme resultat.

Smider jeg et komma ind i mellem filename= of writepassword= får jeg at vide, at variablen filename ikke er defineret...

Du er nu MEGET tæt på dine points - MEN det virker desværre stadig ikke. Kan du klare ovenstående?

En gang til, for at samle op på ovenstående:

Jeg laver det i Visual Basic 6, hvor jeg på en form placere en DirListBox (Dir1) og en FileListBox (File1) samt en TextBox (Text1) - samt en knap command1.

Jeg har følgende kode:

Private Sub Command1_Click()
Dim i As Integer, Sti As String, oDoc As Object, DocApp As Object
Set oDoc = CreateObject(Class:="Word.Document")
Set DocApp = CreateObject(Class:="Word.Application")

For i = 0 To File1.ListCount - 1
  Sti = Dir1.Path & "\" & File1.List(i)
  Set oDoc = DocApp.Documents.Open(Sti)
  DocApp.ActiveDocument.saveas FileName:=Sti, WritePassword:=Trim Text1.Text)
  DocApp.ActiveDocument.Close
Next i
End Sub

Jeg har naturligvis tjekket, at f.eks. "sti" indeholder det der skal. Det der sker når jeg kører programmet, er at cpu-forbruget går til 100% og bliver der, indtil jeg afslutter processen, der bruger cpu'en, nemlig WORD. Men word kan ikke ses i proceslinien. Jeg er ganske sikker på, at man blot skal tage højde for en lillebitte ting, men hvad?

WritePassword:=Trim(Text1.Text) og ikke WritePassword:=Trim Text1.Text), naturligvis ;-)

Her er syntax..
SaveAs(FileName, FileFormat, LockComments, Password, AddToRecentFiles, WritePassword, ReadOnlyRecommended, EmbedTrueTypeFonts, SaveNativePictureFormat, SaveFormsData, SaveAsAOCELetter)

Har du prøvet...
  Set oDoc = DocApp.Documents.Open(Sti)
  DocApp.ActiveDocument.saveas WritePassword:=Trim(Text1.Text)
  DocApp.ActiveDocument.Close

Ja, jeg HAR prøvet
  Set oDoc = DocApp.Documents.Open(Sti)
  DocApp.ActiveDocument.saveas WritePassword:=Trim(Text1.Text)
  DocApp.ActiveDocument.Close
Det fungerer tilsyneladende fint, men der kommer bare IKKE noget password på dokumentet. Jeg vil prøve at rode lidt med det, og du skal nok få dine points - jeg vil bare lige gerne have det til at virke først. Men tak for hjælpen indtil nu!

Prøv at dette link og skriv i søge feltet.
Activedocument saveas

I det første link i listen er der nederst samme beskrivelse, som jeg sendte dig. For en sikkerhedsskyld så her jeg undersøgt og fundet ud af, at samme gælder både for office 2000 og 97.
Håber dette kan hjælpe..

http://msdn.microsoft.com

OK - jeg fik aldrig kikket på det yderligere, da der pludseligt var meget travlt:o( Du får dog dine points da du greb det lidt anderledes (og bedre) an end jeg. Og mon jeg ikke får det til at virke, når jeg får tid.. /Martin