Kennwort per Makro füllen

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hi,
ich mache das, indem ich die Aktualisierung deaktiviere und es manuell anstoße oder auch nicht:
minimale Beispieldaten https://www.herber.de/bbs/user/159954.zip
Im Code der Arbeitsmappe


Option Explicit

Private Sub Workbook_Open()
    'So ist sichergestell, dass nach dem nächsten nicht mehr automatisch nachgefragt wird
    ThisWorkbook.UpdateLinks = xlUpdateLinksNever
    'Auskommentieren, wenn Verknüfungen nicht gewollt/nötig
    aktualisiereVerknüpfung
End Sub

Public Sub aktualisiereVerknüpfung()
    'So geht es manuell
    'Application.Workbooks.Open ThisWorkbook.Path & "\pw01.xlsx", True, False, , "tiger"
    'Application.Workbooks.Open ThisWorkbook.Path & "\pw02.xlsx", True, False, , "tiger2"
    'Application.Workbooks.Open ThisWorkbook.Path & "\pw03.xlsx", True, False, , "tiger3"
    Dim cn As Variant
    Dim strPw As String
    Dim wbFremd(2) As Workbook
    Dim intIndex As Integer
    Application.ScreenUpdating = False
    'Variante über Index
    For Each cn In ThisWorkbook.LinkSources
        intIndex = Val(Left(Right(cn, 7), 2))
        Select Case intIndex
            Case 1
                strPw = "tiger"
            Case 2
                strPw = "tiger2"
            Case 3
                strPw = "tiger3"
        End Select
        Set wbFremd(intIndex - 1) = Application.Workbooks.Open(cn, True, False, , strPw)
    Next
'    'Variante mit beliebigen Namen
'    For Each cn In ThisWorkbook.LinkSources
'        Select Case True
'            'Hier den kompletten Namen mit Pfad angeben
'            Case cn = ThisWorkbook.Path & "\pw01.xlsx"
'                intIndex = 0
'                strPw = "tiger"
'            Case cn = ThisWorkbook.Path & "\pw02.xlsx"
'                intIndex = 1
'                strPw = "tiger2"
'            Case cn = ThisWorkbook.Path & "\pw03.xlsx"
'                intIndex = 2
'                strPw = "tiger3"
'            '.....
'            'immer Paare Name Mappe und Index
'        End Select
'        Set wbFremd(intIndex) = Application.Workbooks.Open(cn, True, False, , strPw)
'    Next
    For intIndex = 0 To 2
        wbFremd(intIndex).Close False
    Next
    Application.ScreenUpdating = True
End Sub

hth
Ulf

Option Explicit Private Sub Workbook_Open() ThisWorkbook.UpdateLinks = xlUpdateLinksNever aktualisiereVerknüpfung End Sub Public Sub aktualisiereVerknüpfung() Dim cn As Variant Dim wbFremd() As Workbook Dim intFiles As Integer Dim intIndex As Integer intIndex = 0 Application.ScreenUpdating = False For Each cn In ThisWorkbook.LinkSources ReDim Preserve wbFremd(intIndex) Set wbFremd(intIndex) = Application.Workbooks.Open(cn, True, False, , "PWD") 'wenn alle Dateien das gleiche Kennwort haben intIndex = intIndex + 1 Next intFiles = UBound(wbFremd) For intIndex = 0 To Max wbFremd(intIndex).Close False Next Application.ScreenUpdating = True End Sub

Private Sub Workbook_Open() Dim LS As Variant Dim inti As Integer ThisWorkbook.UpdateLinks = xlUpdateLinksNever Application.ScreenUpdating = False LS = ActiveWorkbook.LinkSources For inti = 1 To UBound(LS) Workbooks.Open Filename:=LS(inti), Password:="PWD" ', WriteResPassword:="pwd" ActiveWorkbook.Close Next Application.ScreenUpdating = True End Sub

Beliebteste Forumthreads (12 Monate)

8 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread