Kennwortabfrage automatisieren

Question

Ich Grüße euch , ich hoffe ihr könnt mir helfen.
Mein Problem sieht wie folgt aus.

Ich habe eine "projekt.xls" in der ich Daten sammle die ich aus einzelnen Datein automatisch beziehe.

Problem: Die 20 Dateien haben alle ein "Schreib und lese Kennwort".

Beim öffnen der "projekt.xls" muss ich dann alle 20 Kennwörter eingeben. Wie könnte ich vielleicht über ein vba. Dieses Problem umgehen.

Ich danke euch sehr.

Gruß Hermann

Answer 1

Hallo Hermann,

ich habe rund 40 Dateien unter Umständen mit Passwortabfrage zu öffnen und habe von daher dieses Makro im Einsatz:

Sub grpvorlageoeffnen()

Dim varPW As Variant
varPW = InputBox("Diese Funktion ist nur berechtigten Personen erlaubt und daher mit einem Passwort geschützt.")
If varPW = "" Or varPW = False Then Exit Sub
If varPW = "test" Then

Workbooks.Open Filename:= _
"G:\Personal\Gruppenanwesenheitsblätter\Gruppenanwesenheitsblätter 2009\Zeitlohnschein - Stuhlbau Sonder.XLT", Editable:= _
True
Workbooks.Open Filename:="G:\Personal\Gruppenanwesenheitsblätter\Gruppenanwesenheitsblätter 2009\Vorlage für Gruppe 02.xlt" _
, Editable:=True
Workbooks.Open Filename:="G:\Personal\Gruppenanwesenheitsblätter\Gruppenanwesenheitsblätter 2009\Vorlage für Gruppe 04.xlt" _
, Editable:=True
Workbooks.Open Filename:="G:\Personal\Gruppenanwesenheitsblätter\Gruppenanwesenheitsblätter 2009\Vorlage für Gruppe 12.xlt" _
, Editable:=True

Windows("Vorlage für Gruppe 12.xlt").Activate
ActiveSheet.Unprotect "test"
Windows("Vorlage für Gruppe 04.xlt").Activate
ActiveSheet.Unprotect "test"
Windows("Vorlage für Gruppe 02.xlt").Activate
ActiveSheet.Unprotect "test"
Windows("Zeitlohnschein - Stuhlbau Sonder.XLT").Activate
ActiveSheet.Unprotect "test"

Else
MsgBox "Das war leider das falsche Passwort", vbCritical, "Passwortfehler..."
End If

End Sub

Das Passwort ist hier jetzt >> test << .

So ganz ohne Arbeit ist es bei meiner Lösung wie Du siehst aber auch nicht.

Den Pfad und Dateinamen müsstest Du natürlich noch entsprechend anpassen.
Teste es aber auch erstmal in einer Testdatei - nicht das es nachher nicht so läuft wie Du Dir das vorstellst.

Gestartet wird das Makro dann über einen Button...

In diesem Sinne... have a nice Day... Gruß Helmut

Answer 2

Hi, danke für die schnelle Antwort aber das löst mein Problem noch nicht ganz. Oder ich setze es falsch um.
Ich habe die Zeilen etc. alles verbessert. Wo tust du den vba code rein?

bzw. ich habe ja für jedes ein Passwort, hast du für jede Datei das selbe?

Ich dachte eher das man damit hier etwas machen könnte.


Das habe ich gegoogelt.
__________________________________________________

Sub alle_tips_ansehen()

Application.AskToUpdateLinks = False
Application.ScreenUpdating = False
Application.DisplayAlerts = False

Workbooks.Open Filename:="c:\makowski\bundesliga\gesamttippzettel.xls"
Workbooks.Open , Password("columbus"), Filename:="c:\makowski\bundesliga\bernd.XLS"
Workbooks.Open , Password("columbus"), Filename:="c:\makowski\bundesliga\kenny.XLS"
Workbooks.Open , Password("columbus"), Filename:="c:\makowski\bundesliga\jens.XLS"
Workbooks.Open , Password("columbus"), Filename:="c:\makowski\bundesliga\werner.XLS"
Workbooks.Open , Password("columbus"), Filename:="c:\makowski\bundesliga\dirk.XLS"
Workbooks.Open , Password("columbus"), Filename:="c:\makowski\bundesliga\matte.XLS"
Workbooks.Open , Password("columbus"), Filename:="c:\makowski\bundesliga\oppong.XLS"
Workbooks.Open , Password("columbus"), Filename:="c:\makowski\bundesliga\toni.XLS"
Workbooks.Open , Password("columbus"), Filename:="c:\makowski\bundesliga\markus.XLS"
Workbooks.Open , Password("columbus"), Filename:="c:\makowski\bundesliga\thorsten.XLS"
Workbooks.Open , Password("columbus"), Filename:="c:\makowski\bundesliga\klaus.XLS"
Workbooks.Open , Password("columbus"), Filename:="c:\makowski\bundesliga\frank.XLS"
Workbooks.Open , Password("columbus"), Filename:="c:\makowski\bundesliga\karin.XLS"
Workbooks.Open , Password("columbus"), Filename:="c:\makowski\bundesliga\heiko.XLS"
Workbooks.Open , Password("columbus"), Filename:="c:\makowski\bundesliga\becker.XLS"
Workbooks.Open , Password("columbus"), Filename:="c:\makowski\bundesliga\eckart.XLS"
Workbooks.Open , Password("columbus"), Filename:="c:\makowski\bundesliga\mario.XLS"
Workbooks.Open , Password("columbus"), Filename:="c:\makowski\bundesliga\dieter.XLS"
Workbooks.Open , Password("columbus"), Filename:="c:\makowski\bundesliga\thomas.XLS"
Workbooks.Open , Password("columbus"), Filename:="c:\makowski\bundesliga\quang.XLS"
Workbooks.Open , Password("columbus"), Filename:="c:\makowski\bundesliga\sandra.XLS"
Workbooks.Open , Password("columbus"), Filename:="c:\makowski\bundesliga\fred.XLS"
Workbooks.Open , Password("columbus"), Filename:="c:\makowski\bundesliga\carsten.XLS"
Workbooks.Open , Password("columbus"), Filename:="c:\makowski\bundesliga\jan.XLS"
Workbooks.Open , Password("columbus"), Filename:="c:\makowski\bundesliga\andrea.XLS"
Workbooks.Open , Password("columbus"), Filename:="c:\makowski\bundesliga\joachim.XLS"
Application.ScreenUpdating = True
Application.DisplayAlerts = True

Sheets("tabelle36").Select
Range("e3").Select
Application.CommandBars("Worksheet Menu Bar"). _
Controls("Datei").Controls("Beenden").Enabled = False
With ActiveWindow
.DisplayHeadings = False
.DisplayHorizontalScrollBar = False
.DisplayVerticalScrollBar = False
.DisplayWorkbookTabs = False
End With
Windows("__Saison_2003.xls").Activate
Application.AskToUpdateLinks = True
Range("a1").Select
ActiveWorkbook.Save
ActiveWorkbook.Close
End Sub

________________________________

Meins sieht bis jetzt so aus. ->


Sub VorhandeneMappeöffenen_projekte2()
Workbooks.Open "L:\IPG\M_Datei\Projekte2.xls"
MsgBox "Die Projekt Datei ist geöffnet und für Sie bereit! -Updated 21.04.10 -"
Dim varPW As Variant
varPW = InputBox("Diese Funktion ist nur berechtigten Personen erlaubt und daher mit einem Passwort geschützt.")

If varPW = "" Or varPW = False Then Exit Sub
If varPW = "test" Then

Workbooks.Open Filename:= _
"L:\IPG\M_Datei\Udo.xls" _
, Editable:=True
Workbooks.Open Filename:="L:\IPG\M_Datei\Walter.xls" _
, Editable:=True
Workbooks.Open Filename:="L:\IPG\M_Datei\Karl-Heinz.xls" _
, Editable:=True
Workbooks.Open Filename:="L:\IPG\\M_Datei\Bernhard.xls" _
, Editable:=True
Workbooks.Open Filename:="L:\IPG\M_Datei\Achim.xls" _
, Editable:=True
Workbooks.Open Filename:="L:\IPG\\M_Datei\Frank.xls" _
, Editable:=True
Workbooks.Open Filename:="L:\IPG\\M_Datei\Silvia.xls" _
, Editable:=True
Workbooks.Open Filename:="L:\IPG\\M_Datei\Peter.xls" _
, Editable:=True
Workbooks.Open Filename:="L:\IPG\M_Datei\Rheinhard.xls" _
, Editable:=True
Workbooks.Open Filename:="L:\IPG\\M_Datei\Elke.xls" _
, Editable:=True
Workbooks.Open Filename:="L:\IPG\\M_Datei\Gerd.xls" _
, Editable:=True
Workbooks.Open Filename:="L:\IPG\M_Datei\Hermann.xls" _
, Editable:=True

Windows("Udo.xls").Activate
ActiveSheet.Unprotect "13a"
Windows("Walter.xls").Activate
ActiveSheet.Unprotect "12a"
Windows("Katz Karl-Heinz.xls").Activate
ActiveSheet.Unprotect "11a"
Windows("Bernhard.xls").Activate
ActiveSheet.Unprotect "B10a"
Windows("Achim.xls").Activate
ActiveSheet.Unprotect "9a"
Windows("Frank.xls").Activate
ActiveSheet.Unprotect "6a"
Windows("Silvia.xls").Activate
ActiveSheet.Unprotect "5a"
Windows("RD_Laux_Peter.xls").Activate
ActiveSheet.Unprotect "4a"
Windows("Elke.xls").Activate
ActiveSheet.Unprotect "3a"
Windows("Gerd.xls").Activate
ActiveSheet.Unprotect "2a"
Windows("Hermann.xls").Activate
ActiveSheet.Unprotect "1a"


Else
MsgBox "Das war leider das falsche Passwort", vbCritical, "Passwortfehler..."
End If

End Sub

__________________________

Also nochmal, mein Ziel ist es die Datein am besten im Hintergrund zuöffnen. Damit sich die projekt2.xls sich die Daten holen kann.
Es stört halt nur das man

Answer 3

Hi, danke für die schnelle Antwort aber das löst mein Problem noch nicht ganz. Oder ich setze es falsch um.
Ich habe die Zeilen etc. alles verbessert. Wo tust du den vba code rein?

bzw. ich habe ja für jedes ein Passwort, hast du für jede Datei das selbe?

Ich dachte eher das man damit hier etwas machen könnte.


Das habe ich gegoogelt.
__________________________________________________

Sub alle_tips_ansehen()

Application.AskToUpdateLinks = False
Application.ScreenUpdating = False
Application.DisplayAlerts = False

Workbooks.Open Filename:="c:\makowski\bundesliga\gesamttippzettel.xls"
Workbooks.Open , Password("columbus"), Filename:="c:\makowski\bundesliga\bernd.XLS"
Workbooks.Open , Password("columbus"), Filename:="c:\makowski\bundesliga\kenny.XLS"
Workbooks.Open , Password("columbus"), Filename:="c:\makowski\bundesliga\jens.XLS"
Workbooks.Open , Password("columbus"), Filename:="c:\makowski\bundesliga\werner.XLS"
Workbooks.Open , Password("columbus"), Filename:="c:\makowski\bundesliga\dirk.XLS"
Workbooks.Open , Password("columbus"), Filename:="c:\makowski\bundesliga\matte.XLS"
Workbooks.Open , Password("columbus"), Filename:="c:\makowski\bundesliga\oppong.XLS"
Workbooks.Open , Password("columbus"), Filename:="c:\makowski\bundesliga\toni.XLS"
Workbooks.Open , Password("columbus"), Filename:="c:\makowski\bundesliga\markus.XLS"
Workbooks.Open , Password("columbus"), Filename:="c:\makowski\bundesliga\thorsten.XLS"
Workbooks.Open , Password("columbus"), Filename:="c:\makowski\bundesliga\klaus.XLS"
Workbooks.Open , Password("columbus"), Filename:="c:\makowski\bundesliga\frank.XLS"
Workbooks.Open , Password("columbus"), Filename:="c:\makowski\bundesliga\karin.XLS"
Workbooks.Open , Password("columbus"), Filename:="c:\makowski\bundesliga\heiko.XLS"
Workbooks.Open , Password("columbus"), Filename:="c:\makowski\bundesliga\becker.XLS"
Workbooks.Open , Password("columbus"), Filename:="c:\makowski\bundesliga\eckart.XLS"
Workbooks.Open , Password("columbus"), Filename:="c:\makowski\bundesliga\mario.XLS"
Workbooks.Open , Password("columbus"), Filename:="c:\makowski\bundesliga\dieter.XLS"
Workbooks.Open , Password("columbus"), Filename:="c:\makowski\bundesliga\thomas.XLS"
Workbooks.Open , Password("columbus"), Filename:="c:\makowski\bundesliga\quang.XLS"
Workbooks.Open , Password("columbus"), Filename:="c:\makowski\bundesliga\sandra.XLS"
Workbooks.Open , Password("columbus"), Filename:="c:\makowski\bundesliga\fred.XLS"
Workbooks.Open , Password("columbus"), Filename:="c:\makowski\bundesliga\carsten.XLS"
Workbooks.Open , Password("columbus"), Filename:="c:\makowski\bundesliga\jan.XLS"
Workbooks.Open , Password("columbus"), Filename:="c:\makowski\bundesliga\andrea.XLS"
Workbooks.Open , Password("columbus"), Filename:="c:\makowski\bundesliga\joachim.XLS"
Application.ScreenUpdating = True
Application.DisplayAlerts = True

Sheets("tabelle36").Select
Range("e3").Select
Application.CommandBars("Worksheet Menu Bar"). _
Controls("Datei").Controls("Beenden").Enabled = False
With ActiveWindow
.DisplayHeadings = False
.DisplayHorizontalScrollBar = False
.DisplayVerticalScrollBar = False
.DisplayWorkbookTabs = False
End With
Windows("__Saison_2003.xls").Activate
Application.AskToUpdateLinks = True
Range("a1").Select
ActiveWorkbook.Save
ActiveWorkbook.Close
End Sub

________________________________

Meins sieht bis jetzt so aus. ->


Sub VorhandeneMappeöffenen_projekte2()
Workbooks.Open "L:\IPG\M_Datei\Projekte2.xls"
MsgBox "Die Projekt Datei ist geöffnet und für Sie bereit! -Updated 21.04.10 -"
Dim varPW As Variant
varPW = InputBox("Diese Funktion ist nur berechtigten Personen erlaubt und daher mit einem Passwort geschützt.")

If varPW = "" Or varPW = False Then Exit Sub
If varPW = "test" Then

Workbooks.Open Filename:= _
"L:\IPG\M_Datei\Udo.xls" _
, Editable:=True
Workbooks.Open Filename:="L:\IPG\M_Datei\Walter.xls" _
, Editable:=True
Workbooks.Open Filename:="L:\IPG\M_Datei\Karl-Heinz.xls" _
, Editable:=True
Workbooks.Open Filename:="L:\IPG\\M_Datei\Bernhard.xls" _
, Editable:=True
Workbooks.Open Filename:="L:\IPG\M_Datei\Achim.xls" _
, Editable:=True
Workbooks.Open Filename:="L:\IPG\\M_Datei\Frank.xls" _
, Editable:=True
Workbooks.Open Filename:="L:\IPG\\M_Datei\Silvia.xls" _
, Editable:=True
Workbooks.Open Filename:="L:\IPG\\M_Datei\Peter.xls" _
, Editable:=True
Workbooks.Open Filename:="L:\IPG\M_Datei\Rheinhard.xls" _
, Editable:=True
Workbooks.Open Filename:="L:\IPG\\M_Datei\Elke.xls" _
, Editable:=True
Workbooks.Open Filename:="L:\IPG\\M_Datei\Gerd.xls" _
, Editable:=True
Workbooks.Open Filename:="L:\IPG\M_Datei\Hermann.xls" _
, Editable:=True

Windows("Udo.xls").Activate
ActiveSheet.Unprotect "13a"
Windows("Walter.xls").Activate
ActiveSheet.Unprotect "12a"
Windows("Katz Karl-Heinz.xls").Activate
ActiveSheet.Unprotect "11a"
Windows("Bernhard.xls").Activate
ActiveSheet.Unprotect "B10a"
Windows("Achim.xls").Activate
ActiveSheet.Unprotect "9a"
Windows("Frank.xls").Activate
ActiveSheet.Unprotect "6a"
Windows("Silvia.xls").Activate
ActiveSheet.Unprotect "5a"
Windows("RD_Laux_Peter.xls").Activate
ActiveSheet.Unprotect "4a"
Windows("Elke.xls").Activate
ActiveSheet.Unprotect "3a"
Windows("Gerd.xls").Activate
ActiveSheet.Unprotect "2a"
Windows("Hermann.xls").Activate
ActiveSheet.Unprotect "1a"


Else
MsgBox "Das war leider das falsche Passwort", vbCritical, "Passwortfehler..."
End If

End Sub

__________________________

Also nochmal, mein Ziel ist es die Datein am besten im Hintergrund zuöffnen. Damit sich die projekt2.xls sich die Daten holen kann.
Es stört halt nur das man

Answer 4

Hi Hermann,

leider bin ich nicht der VBA-Cr*ck der Dir Dein Problem so lösen kann.

Um Deine Frage, ob ich nur ein Passwort habe, so muss ich dies ganz klar mit ja beantworten. Ich möchte mir nicht für 40 Dateien auch noch 40 verschiedene Passwörter zurechtlegen und wenn ich dann vor Ort mir mal eine Datei ansehen will, dann noch großartig überlegen möchte, welches war es denn. Sicherlich gibt es solche Lösungen wie Du sie hier als Pseudopasswort geschrieben hast (die realen sind es ja sicherlich nicht - könnte ja mal zufällig einer der Kollegen/-innen hier reinschauen und weiß dann Bescheid), aber wie schon geschrieben, wirst Du später noch wissen das Elke mit 3a belegt war?...

Wenn ich Dich aber richtig verstanden habe, dann möchtest Du aus den diversen Kennwortgeschützen Dateien Daten auslesen und in die Projekt 2 einfließen lassen.

Frage... gibt es diese Automatisierung bereits oder wäre das etwas was Du eher suchst - natürlich in Verbindung mit öffnen und später wieder schließen der kennwortgeschützten Dateien....?

Wie Eingangs schon geschrieben bin ich leider nicht der VBA-Kenner, wie es sie hier gibt und hoffe mal das Dir jemand anderes helfen kann.

Allerdings wäre es auch für die Helfer hilfreich, falls Du den Code zum Übermitteln der Daten und späteren schließen der Kennwortgeschützten Dateien als solches suchst, das Du dann angibst, welche Daten von wo nach wo und unter welchen Bedingungen fließen sollen. Am Besten wäre dann noch eine mit fiktiven Daten gefüllte Projekt2-Datei ins Nezt zu stellen, damit die VBA-Kenner sich ein besseres Bild machen können.

Leider werde ich an dieser Stelle wohl aussteigen müssen und wünsche Dir das Dir jemand weiterhelfen kann.

In diesem Sinne... have a nice Day... Gruß Helmut

Answer 5

Hallo Hermann,

nachtrag, da mir aufgefallen ist, dass Du noch eine Frage bzgl. des Makros hattest... wo das rein soll?...

Ich habe dafür aus der Symbolleiste - Formular - den Button Schaltfläche verwendet. (nicht verwechseln mit Befehlsschaltfläche aus Steuerelement-Toolbox...

Einfach einen Klick auf das Symbol Schaltfläche - dann ein Rechteck Deiner Größe ziehen und bei Makro - Neu - auswählen (nicht aufzeichnen). Dann den Code da reinkopieren - fertig.

Im Nachhin glaube ich zu verstehen was Du meinst... ich denke Du hast da in einer Zelle yx.. =Gerd!a1 oder sowas drin und dann wäre mir klar, dass Du die entsprechenden Abfragen erhältst.

Hier könnte Dir ein Makro die arbeit sicherlich noch einfacher machen, wenn die Helfer wissen, welche Inhalte von wo nach wo kopiert werden sollen und dann sollte es aus meiner Sicht so aussehen...

Button anklicken - Kennwortgeschützte Dateien öffnen, Daten von Ursprung nach Ziel (Projekt2) kopieren und die Dateien dann wieder Kennwortgeschützt schließen... ?
Oder ist es doch was anderes was Du möchtest...?

In diesem Sinne... have a nice Day... Gruß Helmut

Answer 6

Ich Grüße dich Helmut, ich danke dir für deine Mühe bzw. Antworten.

Das fließen der Informationen habe ich schon soweit fertig.

Es sieht wie folgt auf. Ich öffne die projekt2.xls und es fragt mich ob ich die Datei aktualisieren möchte.
Nachdem ich dann auf aktualisieren klicke kommt die Password abfrage, der einzelnen Dateien. Da diese jeweils mit einem Sichtschutz versehen sind.
Mein problem ist es also nicht dass sich die Projekt2.xls die Datei aus ein bestimmten Zeile bezieht. sondern das ich immer wieder die Passwörter eingeben muss.
Das möchte ich gerne unterbinden.

Schöner Gruß Hermann

Answer 7

Hallo Hermann,

leider hast Du mir und anderen Helferleins nicht so ganz die Antwort auf meine Frage gegeben, da ich jetzt eben nach wie vor nur vermuten kann, dass Du die Werte über die Verknüpfungen von den einzelnen Dateien zu der Projekt2 erhältst.

Von daher habe ich mich halt gefragt, ob es nicht einfacher wäre ein komplettes Makro - wie in AW5 im letzten Absatz - zu generieren, die eben alles in einem abdeckt.

Ansonsten - nur zum öffnen der Kennwortgeschützten Dateien würde der Button ja sein übriges tun.

Analog könnte man dann natürlich noch einen zweiten Button anlegen, der alle vorher geöffneten Dateien auch wieder mit Kennwortschutz schließt und ggf. speichert.

Alternativ kann man auch auf die Buttons verzichten und zwei Symbole in die Symbolleiste integrieren.

Sorry, aber eine automatische Öffnung mit automatischer Kennworteingabe bei Verknüpfungen ist mir so nicht bekannt, was aber nicht heißen soll, dass es sowas evtl. nicht gibt.

Vielleicht nur mal so als Idee, das Konzept ein wenig mit einem Makro komplett zu überarbeiten.

In diesem Sinne... have a nice Day... Gruß Helmut

Answer 8

Hallo Hermann,

bin mal wieder noch nicht fertig mit Deiner Anfrage und hier eine Info mehr.

Öffne mal die Datei Projekt2, da dort ja alle Verknüpfungen reinlaufen.

Dann auf >> Bearbeiten << und dort auf >> Verknüpfungen <<

Daraufhin erscheint ein neues Fenster, bei dem Du in dem unteren Bereich durch anklicken von ... Eingabeaufforderung beim Start
zumindest dann schon mal die Anfrage unterdrücken kannst.
Ob Du dann sofort oder später die Aktualisierung vornehmen möchtest (die ja dann auch automatisch vonstatten geht, wenn alle Dateien geöffnet sind), könntest Du also vorher alles unterdrücken.
Dann den Button mit dem Makro starten und anschließend alle Dateien wieder schließen lassen....
Tja... mehr geht glaube ich jetzt wirklich nicht mehr, außer wie bereits in AW5 und AW7 beschrieben, alles per Makro zu machen.
Aber ich denke mit der Einstellungsmöglichkeit bist Du auch schon mal einen Schritt weiter ;-).

In diesem Sinne... have a nice Day... Gruß Helmut