Rimozione protezione da foglio Excel tramite VBA da Access

Question

Salve a tutti,

ho un problema con una sub su un pulsante di una maschera che ha il compito di: copiare un modello excel 2007, aprire il file excel, togliere la protezione del foglio, scrivere delle celle, ridare la protezione, rinominare il foglio, collegarlo all'access 2007, e poi fare alcune operazioni sulla maschera da cui si è attivata la sub.

Premetto che sono alle prime armi con VBA.

Il problema in se è solo che tale operazione riesce solo alla creazione del primo file excel dalla maschera.

Quando creo un secondo file excel da errore di run-time 1004: Metodo 'worksheets' dell'oggetto '_global' non riuscito.

Penso il problema sia sulla rimozione password ma non ne vengo fuori.

Option Compare Database

Option Explicit

Dim oExcel As Object

Dim oWorkbook As Object

Dim oWorksheet As Object

Private Sub Comando29_Click()

Dim D As String

D = DCount("Name", "[BOM del PREV]") + 1

Dim SourceFile, DestinationFile

SourceFile = "C:\Documents and Settings...\nuovabomprev.xlsx"

DestinationFile = "c:\Documents and Settings...\P" & SelIDRegPrev & "-" & D & "-" & RevisBOMPrev & "-" & NomeArticolo & "-" & QuantitàArticolo & ".xlsx"

FileCopy SourceFile, DestinationFile

Set oExcel = CreateObject("Excel.Application")

Set oWorkbook = oExcel.Workbooks.Open("c:\Documents and Settings...\P" & SelIDRegPrev & "-" & D & "-" & RevisBOMPrev & "-" & NomeArticolo & "-" & QuantitàArticolo & ".xlsx", True, False)

oExcel.Visible = True

Set oWorksheet = oWorkbook.Worksheets("F1PREV")

Worksheets("F1PREV").Unprotect Password:="kiwi"

oWorksheet.Cells(2, 1).Value = "P" & SelIDRegPrev & "-" & D & "-" & RevisBOMPrev & "-" & NomeArticolo & "-" & QuantitàArticolo

oWorksheet.Cells(2, 2).Value = NomeArticolo

oWorksheet.Cells(2, 3).Value = QuantitàArticolo

Worksheets("F1PREV").Protect Password:="kiwi"

oWorksheet.Name = oWorksheet.Cells(2, 1).Value

oWorkbook.Save

DoCmd.TransferSpreadsheet acLink, 10, "P" & SelIDRegPrev & "-" & D & "-" & RevisBOMPrev & "-" & NomeArticolo & "-" & QuantitàArticolo, "c:\Documents and Settings...\P" & SelIDRegPrev & "-" & D & "-" & RevisBOMPrev & "-" & NomeArticolo & "-" & QuantitàArticolo & ".xlsx", True, "A1:AZ500"

DoCmd.GoToControl "NomeArticolo"

DoCmd.RunCommand acCmdDelete

DoCmd.GoToControl "QuantitàArticolo"

DoCmd.RunCommand acCmdDelete

DoCmd.Requery "SelTabBOM"

DoCmd.Requery "ProgressBOMPrev"

end sub

Grazie ciao.

Answer 1

a Maurizio .. 

Mi sembra di aver capito che il tuo codice non abbisogna di dichiarare la directory ..

non mio caso non funziona e mi dice "SEM impossibile trovar il file" (SEM è la cartella immediatamente accanto al file access).

Dovevo specificare che lavoro da hard-disk con l'access e gli excel sono nel desktop? ...

Forse rispetto al mio codice basterebbe una gestione dell'errore, ma purtroppo non saprei come gestirlo ...

Una domanda: che differenza fa tra lavorare con 

 Dim xlApp As Object

 Dim xlWbk As Object

 Dim xlWsh As Object

Rispetto a

 Dim oExcel As Object

 Dim oWorkbook As Object

 Dim oWorksheet As Object

Grazie infinite.

Answer 2

Sempre a Sandro .. non ho usato 

 Private Const strPath As String = "C:\pathExcelFiles"

'penso servi a semplificare il codice vero? ... credo che la directory la scriverò in una casella di testo e poi la richiamerò per semplificare lo spostamento del file access.

poi mi dicevi:

la Dcount restituisce un variant c'è una ragione particolare per restituire una variabile string?

No nel mio codice ce as String

Ciao.

Answer 3

Salve Sandro!.. rispondo prima a te ! .. 

ho usato 

oWorkbsheets("F1PREV").Unprotect Password:="kiwi"

al posto di

Worksheets("F1PREook.WorkV").Unprotect Password:="kiwi"

e va meglio perchè rispetto a prima al secondo file creato mi scrive le celle (prima non lo faceva) mentre ancora non rinomina il foglio e non salva (nemmeno prima).

se anche modifico

Worksheets("F1PREV").Protect Password:="kiwi"

con la tua

 oWorkbook.oWorksheet("F1PREV").Protect Password:="kiwi"

gia al primo giro da errore di runtime 438 - proprietà o metodo non supportati dall'oggetto

ps il nick è new non net ;-)

Answer 4

Ciao newstarttoday,

una modesta proposta (da verificare):

Private Sub Comando29_Click()

On Error GoTo ErrH

#Const DevMode = 0

#If DevMode Then

  Dim xlApp As Excel.Application

  Dim xlWbk As Excel.Workbook

  Dim xlWsh As Excel.Worksheet

#Else

  Dim xlApp As Object

  Dim xlWbk As Object

  Dim xlWsh As Object

#End If

Dim d           As String

Dim strRoot     As String

Dim strExt      As String

Dim strSrcName  As String

Dim strDstName  As String

Dim strWshName  As String

      d = CStr(DCount("Name", "[BOM del PREV]") + 1)

      strRoot = Environ$("HOMEDRIVE") & Environ$("HOMEPATH") & ""

      strExt = ".xlsx"

      strWshName = "F1PREV"

      strSrcName = "nuovabomprev"

      strDstName = "P" & _

                   SelIDRegPrev & "-" & d & "-" & _

                   RevisBOMPrev & "-" & _

                   NomeArticolo & "-" & _

                   QuantitàArticolo

      FileCopy strRoot & strSrcName & strExt, _

               strRoot & strDstName & strExt

      Set xlApp = CreateObject("Excel.Application")

      Set xlWbk = xlApp.Workbooks.Open(strRoot & strDstName & strExt, _

                                       UpdateLinks:=True, _

                                       readOnly:=False)

      xlApp.Visible = True

      Set xlWsh = xlWbk.Worksheets(strWshName)

      'xlWsh.UnProtect Password:="kiwi"

      xlWsh.Protect Password:="kiwi", UserInterfaceOnly:=True

      xlWsh.Cells(2, 1).Value = strDstName

      xlWsh.Cells(2, 2).Value = NomeArticolo

      xlWsh.Cells(2, 3).Value = QuantitàArticolo

      'xlWsh.Protect Password:="kiwi"

      xlWsh.Name = xlWsh.Cells(2, 1).Value

      'xlWbk.Save

      xlWbk.Close SaveChanges:=True

      DoCmd.TransferSpreadsheet TransferType:=acLink, _

                                SpreadSheetType:=acSpreadsheetTypeExcel12Xml, _

                                TableName:=strDstName, _

                                FileName:=strRoot & strDstName & strExt, _

                                HasFieldNames:=True, _

                                Range:="A1:AZ500"

      DoCmd.GoToControl "NomeArticolo"

      DoCmd.RunCommand acCmdDelete

      DoCmd.GoToControl "QuantitàArticolo"

      DoCmd.RunCommand acCmdDelete

      DoCmd.Requery "SelTabBOM"

      DoCmd.Requery "ProgressBOMPrev"

ExtP: On Error Resume Next

      xlApp.DisplayAlerts = False

      xlApp.Quit

      Set xlWsh = Nothing

      Set xlWbk = Nothing

      Set xlApp = Nothing

      On Error GoTo 0

      Exit Sub

ErrH:

      With Err

        MsgBox .Source & vbNewLine & .Description, _

               vbCritical, _

               "ERR#" & CStr(.Number)

      End With

      Resume ExtP

End Sub

Answer 5

ciao NetStartToday,

ho inserito una costante per il percorso, personalizzala correttamente.

la Dcount restituisce un variant c'è una ragione particolare per restituire una variabile string?

una volta che crei le variabili oggetto è bene distruggerle

prova così :

Option Compare Database

 Dim oExcel As Object

 Dim oWorkbook As Object

 Dim oWorksheet As Object

 Private Const strPath As String = "C:\pathExcelFiles" ' <--- personalizza

Private Sub Comando0_Click()

Dim D As Variant

 D = DCount("Name", "[BOM del PREV]") + 1

 Dim SourceFile, DestinationFile

 SourceFile = strPath & "f123.xls"

 DestinationFile = strPath & SelIDRegPrev & "-" & D & "-" & RevisBOMPrev & "-" & NomeArticolo & "-" & QuantitàArticolo & ".xls"

 FileCopy SourceFile, DestinationFile

 Set oExcel = CreateObject("Excel.Application")

 Set oWorkbook = oExcel.Workbooks.Open(strPath & SelIDRegPrev & "-" & D & "-" & RevisBOMPrev & "-" & NomeArticolo & "-" & QuantitàArticolo & ".xls", True, False)

 oExcel.Visible = True

 Set oWorksheet = oWorkbook.Worksheets("F1PREV")

 oWorkbook.Worksheets("F1PREV").Unprotect Password:="kiwi"

 oWorksheet.Cells(2, 1).Value = "P" & SelIDRegPrev & "-" & D & "-" & RevisBOMPrev & "-" & NomeArticolo & "-" & QuantitàArticolo

 oWorksheet.Cells(2, 2).Value = NomeArticolo

 oWorksheet.Cells(2, 3).Value = QuantitàArticolo

 oWorkbook.oWorksheet("F1PREV").Protect Password:="kiwi"

 oWorksheet.Name = oWorksheet.Cells(2, 1).Value

 oWorkbook.Save

 DoCmd.TransferSpreadsheet acLink, 10, "P" & SelIDRegPrev & "-" & D & "-" & RevisBOMPrev & "-" & NomeArticolo & "-" & QuantitàArticolo, strPath & SelIDRegPrev & "-" & D & "-" & RevisBOMPrev & "-" & NomeArticolo & "-" & QuantitàArticolo & ".xls", True, "A1:AZ500"

 DoCmd.GoToControl "NomeArticolo"

 DoCmd.RunCommand acCmdDelete

 DoCmd.GoToControl "QuantitàArticolo"

 DoCmd.RunCommand acCmdDelete

 DoCmd.Requery "SelTabBOM"

 DoCmd.Requery "ProgressBOMPrev"

 Set oExcel = Nothing

 Set oWorkbook = Nothing

 Set oWorksheet = Nothing

End Sub

ciao, Sandro.