Daten in passwortgeschützes Workbook einfügen
13.10.2014 21:11:47
Andre
ich hoffe ihr könnt mir ein wenig helfen.Ich habe hier im Forum die Datei 69694.zip
an meine Bedürfnisse angepasst. (Dank an die Ersteller). Ich bin Dank eurer Hilfe mittlerweile gut vorwärts gekommen und die Tabelle an meine Bedürfnitte angepasst(Habe eigentlich keine VBA Kenntnisse)
Sinn ist es die Daten einer Userform in eine Externe Datei zu Übertragen, wobei jeder Datensatz in die nächste freie Zeile geschrieben wird. Das Prozedere geht durch öffnen/einfügen/Speichern/schließen der Datei
Um die "Empfängerdatei" zu schützen, würde ich diese gern durch "Speichern unter" mit einem Passwort versehen. So das diese Datei nur mittels Passwort "XYZ" geöffnet werden kann. (Also die gesamte Datei und nicht nur ein Tabellenblatt oder Zelle schützen).
Derzeit ist diese noch ungeschützt.
Wie oder was muss ich wo eingeben, um zu gewährleisten das die Empfängerdatei entsperrt und geöffnet/beschrieben/gespeichert/geschlossen und gesperrt wird.
Ich hab mal den Code angeführt wo ich glaube, das es eingebaut werden muß.
Sollte noch/oder etwas anders von Nöten sein bitte um Info. Vielen Dank. Hab versucht das zu ergooglen, aber es liest sich alles irgenwie anders und ich wüsste nicht wo ich das gelesene bei mir einfügen soll.
Private Sub Workbook_Open()
Dim wb As Workbook
Dim sFile As String, arrKunden, vAuswahl
On Error GoTo Fehler
Application.ScreenUpdating = False
Application.StatusBar = "Kundenauswahl für Combobox wird geladen"
'Dateiname der Kundenliste - wird auch im Userform-Modul genutzt
sFile_Kundenliste = "I:\VBAEngine\Code\2014\Nov\Kundenliste1.2.xls" 'anpassen !!!
Set wb = Application.Workbooks.Open(Filename:=sFile_Kundenliste, ReadOnly:=True)
With wb.Worksheets("Kundenliste")
arrKunden = .Range(.Cells(2, 1), .Cells(.Rows.Count, 1).End(xlUp))
End With
wb.Close savechanges:=False
Application.ScreenUpdating = True
Application.StatusBar = False
Fehler:
With Err
Select Case .Number
Case 0 'Alles OK
Case Else
Application.StatusBar = False
Application.ScreenUpdating = False
MsgBox "Fehler-Nr.: " & .Number & vbLf & .Description
End Select
End With
Set wb = Nothing: arrKunden = Null
End Sub