gesloten beveiligde bestanden ophalen.

[popipipo]

Ik heb 1 bestand (popipipo file 1.xls) en wil vanuit hier berekeningen doen.
Via VBA die ik hier gekregen heb haal ik een tiental (gesloten) bestanden (popipipo file 2.xls) op.
Allen gelijk van layout.
Dit gaat prima totdat op de bestanden (popipipo file 2.xls) die ik wil op halen een beveiliging zet.
Dan stop de upload.
De beveiliging zit er alleen op om niet per ongeluk sommige gegevens te wissen.

Ik denk dat de vba in popipipo file 2.xls ook nog iets aan gepast kan worden
Het bestand bevat nl ALTIJD maar 1 tabblad en de vba gaat het aantal tabbladen tellen, dat is dus overbodig.

 

[oeldere]

Beste popipipo,

Zonder je bestanden gezien te hebben, lees ik in je tekst dat ik eenzelfde probleem heb gehad met het openen met een wachtwoord op de bestanden.

Zie voor die aangedragen oplossingen hier

Zoals je weet ben ik geen VBA kenner.

Dus waarschijnlijk zul je door derden "beter" worden geholpen.

 

[popipipo]

Wat vba kennis betreft zijn wij denk ik ongeveer gelijk

Als ik jou vbtje goed lees, denk ik dat je alleen gegevens uit een bestand haalt.
Mijn bestand haalt een heel tabblad binnen als die nog niet bestaat en vervangt de nieuwe voor de oude.
En om dit om te zetten, je raad het waarschijnlijk al, heb je toch iets meer kennis van vba nodig dan ik bezit.
Je reactie wordt uiteraard wel gewaardeerd.

 

[Warme bakkertje]

Sub CombineFiles()
Dim path            As String
Dim FileName        As String
Dim LastCell        As Range
Dim Wkb             As Workbook
Dim ThisWB          As String
 
ThisWB = ThisWorkbook.Name
With Application
    .ScreenUpdating = False
    .EnableEvents = False
    .DisplayAlerts = False
'path = GetDirectory
path = Range("ophaaldir")

FileName = Dir(path & "\*.xls", vbNormal)
Do Until FileName = ""
    If FileName <> ThisWB Then
        Set Wkb = Workbooks.Open(FileName:=path & "\" & FileName)
        With Wkb.Sheets(1)
            .Unprotect
            Set LastCell = .Cells.SpecialCells(xlCellTypeLastCell)
            If LastCell.Value = "" And LastCell.Address = .Range("$A$1").Address Then
            Else
                .Name = .[A1].Value
                .Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
                If WorksheetExists(.Name & Chr(32) & "(2)") Then
                        Sheets(.Name).Delete
                        Sheets(.Name & Chr(32) & "(2)").Name = [A1].Value
                End If
                End If
        ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count).Protect
        End With
        Wkb.Close False
    End If
    FileName = Dir()
Loop
    .DisplayAlerts = True
    .EnableEvents = True
    .ScreenUpdating = True
End With

Set Wkb = Nothing
Set LastCell = Nothing
End Sub

 

[popipipo]

Rudi, hartelijk dank voor de aanpassing. :thumb: :thumb:
Werkt nu naar behoren.

ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count).Protect

Deze regel heb ik er uitgehaald want het in/uitklappen van de verschillende groepen werkt dan niet.
Het beveiligen was ook niet echt meer nodig, omdat deze in het invulblad zat alleen tegen een per ongeluk verkeerde invoer. De invoer is gedaan dus beveiliging niet meer nodig.

 

[Warme bakkertje]

Graag gedaan.