rimuovere protezione cartella

Hai un problema con Excel?

Nuova discussione

rimuovere protezione cartella...
di ijk (utente non iscritto) data: 08/12/2012 19:47:47
Salve :) buon weekend. Non mi faccio sentire da molto ma ogni tanto vengo a dare un'occhiata :) Oggi però sono qui perché ho il seguente problema: sto usando il codice scritto da Ron de Bruin per estrarre dati da un gruppo di files excel contenuti in una cartella senza aprirli. Il problema è che il codice non funziona se è protetta la cartella di lavoro dei file da cui si vogliono estrarre i dati.
Il problema si potrebbe risolvere scrivendo del codice che apre ciascun file e sprotegge la cartella di lavoro e poi lo chiude salvandolo. Ma siccome i file sono 50, sapete se è possibile rimuovere tale protezione senza aprire il file?
Dipende dal fatto che non si accede al file in sola lettura secondo voi?

'la subroutine'
Sub GetData_Example5()
    Dim SaveDriveDir As String, MyPath As String
    Dim FName As Variant, N As Long
    Dim rnum As Long, destrange As Range
    Dim sh As Worksheet

    SaveDriveDir = CurDir
    MyPath = Application.DefaultFilePath    'or use "C:Data"
    ChDrive MyPath
    ChDir MyPath
    FName = Application.GetOpenFilename(filefilter:="Excel Files,*.xl*", _
                                        MultiSelect:=True)
    If IsArray(FName) Then
        ' Sort the Array
        FName = Array_Sort(FName)

        Application.ScreenUpdating = False
        'Add worksheet to the Activeworkbook and use the Date/Time as name
        Set sh = ActiveWorkbook.Worksheets.Add
        sh.Name = Format(Now, "dd-mm-yy h-mm-ss")

        'Loop through all files you select in the GetOpenFilename dialog
        For N = LBound(FName) To UBound(FName)

            'Find the last row with data
            rnum = LastRow(sh)

            'create the destination cell address
            Set destrange = sh.Cells(rnum + 1, "A")

            ' For testing Copy the workbook name in Column E
            sh.Cells(rnum + 1, "E").Value = FName(N)


            'Get the cell values and copy it in the destrange
            'Change the Sheet name and range as you like
            GetData FName(N), "Riepilogo_2012-13", "T3:T5", destrange, False, False
        Next

    End If
    ChDrive SaveDriveDir
    ChDir SaveDriveDir
    Application.ScreenUpdating = True
End Sub

'le funzioni...'

Public Sub GetData(SourceFile As Variant, SourceSheet As String, _
                   SourceRange As String, TargetRange As Range, Header As Boolean, UseHeaderRow As Boolean)
' 30-Dec-2007, working in Excel 2000-2007
    Dim rsCon As Object
    Dim rsData As Object
    Dim szConnect As String
    Dim szSQL As String
    Dim lCount As Long

    ' Create the connection string.
    If Header = False Then
        If Val(Application.Version) < 12 Then
            szConnect = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
                        "Data Source=" & SourceFile & ";" & _
                        "Extended Properties=""Excel 8.0;HDR=No"";"
        Else
            szConnect = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
                        "Data Source=" & SourceFile & ";" & _
                        "Extended Properties=""Excel 12.0;HDR=No"";"
        End If
    Else
        If Val(Application.Version) < 12 Then
            szConnect = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
                        "Data Source=" & SourceFile & ";" & _
                        "Extended Properties=""Excel 8.0;HDR=Yes"";"
        Else
            szConnect = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
                        "Data Source=" & SourceFile & ";" & _
                        "Extended Properties=""Excel 12.0;HDR=Yes"";"
        End If
    End If

    If SourceSheet = "" Then
        ' workbook level name
        szSQL = "SELECT * FROM " & SourceRange$ & ";"
    Else
        ' worksheet level name or range
        szSQL = "SELECT * FROM [" & SourceSheet$ & "$" & SourceRange$ & "];"
    End If

    On Error GoTo SomethingWrong

    Set rsCon = CreateObject("ADODB.Connection")
    Set rsData = CreateObject("ADODB.Recordset")

    rsCon.Open szConnect
    rsData.Open szSQL, rsCon, 0, 1, 1
    'rsData.Open szSQL, rsCon, 0, 0, 0

    ' Check to make sure we received data and copy the data
    If Not rsData.EOF Then

        If Header = False Then
            TargetRange.Cells(1, 1).CopyFromRecordset rsData
        Else
            'Add the header cell in each column if the last argument is True
            If UseHeaderRow Then
                For lCount = 0 To rsData.Fields.Count - 1
                    TargetRange.Cells(1, 1 + lCount).Value = _
                    rsData.Fields(lCount).Name
                Next lCount
                TargetRange.Cells(2, 1).CopyFromRecordset rsData
            Else
                TargetRange.Cells(1, 1).CopyFromRecordset rsData
            End If
        End If

    Else
        MsgBox "No records returned from : " & SourceFile, vbCritical
    End If

    ' Clean up our Recordset object.
    rsData.Close
    Set rsData = Nothing
    rsCon.Close
    Set rsCon = Nothing
    Exit Sub

SomethingWrong:
    MsgBox "The file name, Sheet name or Range is invalid of : " & SourceFile, _
           vbExclamation, "Error"
    On Error GoTo 0

End Sub

Function LastRow(sh As Worksheet)
    On Error Resume Next
    LastRow = sh.Cells.Find(What:="*", _
                            After:=sh.Range("A1"), _
                            Lookat:=xlPart, _
                            LookIn:=xlFormulas, _
                            SearchOrder:=xlByRows, _
                            SearchDirection:=xlPrevious, _
                            MatchCase:=False).Row
    On Error GoTo 0
End Function

di Vecchio Frac data: 08/12/2012 20:58:43
Ma la cartella di lavoro "protetta" è una cartella di Windows? o intendi una cartella di fogli Excel (Workbook)?
IN questo secondo caso, conosci la password di protezione?
Esistono il comando Unprotect per togliere una protezione e Protect per riattivarla: sono metodi sia di Worksheet che di Workbook (per agire su un foglio o sull'intera cartella) e si può specificare la password.

L'errore che ricevi (non dici quale sia, ma nell'altro thread indichi una linea precisa dove si verifica) potrebbe riguardare il percorso del file da aprire o il nome del foglio (che deve esserci e essere uguale in tutti i file da esaminare: "Riepilogo_2012-13").
di ijk (utente non iscritto) data: 08/12/2012 22:41:00
ciao Vecchio Frac, intendo una cartella excel workbook e conosco la password. In pratica ho un insieme di file excel, identici come struttura (con gli stessi fogli di lavoro) e devo estrarre dei dati. ho fatto delle prove, ma se è attivata la protezione sulla cartella (workbook) non va'. Conosco i comandi protect e unprotect, quindi tu dici che potrei inserire il comando nella subroutine GetData ... ok, provo. ...altro tread?...ma dove l'ho postato? :( l'errore viene intercettato da on error...

di Vecchio Frac data: 09/12/2012 22:48:48
Ho trovato in rete un workaround per risolvere il problema del file protetto da password al quale non si può accedere col metodo che hai descritto, neanche con Protect/Unprotect.
In alternativa consiglio di aprire il file nascondendolo (visible=false), recuperare le righe che servono e quindi chiuderlo.

'L'inconveniente è che chiederà la password ad ogni apertura di file... ma poi dovrebbe funzionare correttamente.

    Dim xl As Object
    Set xl = GetObject(CurrentProject.Path & "" & "excel_file.xls")

    Dim cnn1 As New ADODB.Connection
    Dim rst1 As ADODB.Recordset
    Dim strExcelName As String = "excel_file.xls"
    Dim strWkBkName As String = "[" & "sheet_name" & "$]"
    cnn1.Open "Provider=Microsoft.Jet.OLEDB.4.0;" _
    "Data Source=" & CurrentProject.Path & "" & "excel_file.xls" & ";" _
    "Extended Properties=""Excel 8.0;"";"
    Set rst1 = New ADODB.Recordset
    rst1.Open strWkBkName, cnn1, , , adCmdTable
    Do Until rst1.EOF
        'manipoliamo i dati
        rst1.MoveNext
    Loop

Vuoi Approfondire?