Autostore Password for Export from Access query to Excel MULTIPLE Sheets.

[Malungo1970]

Hi Everyone,

I'm using a code to export a query from Access to create a new Excel with 1 Sheet and Protect with password, and everything's right.

Private Sub botton_Click()
On Error GoTo Err_botton_Click
 
 Dim excelapp As New Excel.Application
 Dim excelfile As New Excel.Workbook
 Dim excelsheet As New Excel.Worksheet
 
DoCmd.TransferSpreadsheet acExport, , "query1", "C:\PED.xlsx", False
 
 Set excelfile = excelapp.Workbooks.Open("C:\PED.xlsx")
 
Set excelsheet = excelfile.Worksheets.ITEM(1)
excelsheet.Protect Password:="secret"
 
excelfile.Save
 
excelapp.ActiveWorkbook.Close True, "C:\PED.xlsx"
excelapp.Quit
 
Set excelsheet = Nothing
Set excelfile = Nothing
Set excelapp = Nothing
 
Exit_botton_Click:
    Exit Sub
 
Err_botton_Click:
    MsgBox Err.Number & " - " & Err.Description
    Resume Exit_botton_Click
End Sub

My reference it was that post:

http://bytes.com/topic/access/answer...el-spreadsheet

But I got Error 1004 when I try to use the Code to Protect a Excel with 3 Sheets, Could You help me please?

Private Sub botton_Click()
On Error GoTo Err_botton_Click
 
 Dim excelapp As New Excel.Application
 Dim excelfile As New Excel.Workbook
 Dim excelsheet As New Excel.Worksheet
 
DoCmd.TransferSpreadsheet acExport, , "query1", "C:\PED.xlsx", False
DoCmd.TransferSpreadsheet acExport, , "query2", "C:\PED.xlsx", False
DoCmd.TransferSpreadsheet acExport, , "query3", "C:\PED.xlsx", False
 
 Set excelfile = excelapp.Workbooks.Open("C:\PED.xlsx")
 
Set excelsheet = excelfile.Worksheets.ITEM(1)
excelsheet.Protect Password:="secret"   'ERROR 1004 in this line
 Set excelsheet = excelfile.Worksheets.ITEM(2)
excelsheet.Protect Password:="secret"
Set excelsheet = excelfile.Worksheets.ITEM(3)
excelsheet.Protect Password:="secret"
 
excelfile.Save
 
excelapp.ActiveWorkbook.Close True, "C:\PED.xlsx"
excelapp.Quit
 
Set excelsheet = Nothing
Set excelfile = Nothing
Set excelapp = Nothing
 
Exit_botton_Click:
    Exit Sub
 
Err_botton_Click:
    MsgBox Err.Number & " - " & Err.Description
    Resume Exit_botton_Click
End Sub

Thanks for all and best wishes from Brazil.

[zmbd]

--> Please provide BOTH the NUMBER and the EXACT TEXT of the error message.

--> Please provide the version of Office/Access you are using.

Depending on the version of office AND the EXACT NUMBER and EXACT text (please do not paraphrase or alter the text in any way) of the error message you received:
VBA-RT-Error-1004 can refer to:
- vba security violation at object
- error of method
- error in writing to read-only file or object


etc...

[Malungo1970]

Here We go:

1. runtime error 1004 application defined or object defined

2. WIN7 and Office/Ms Access 2010

Thank You Zmbd for your attention.

[ADezii]

May be a Version problem, since the following Code ran flawlessly:

Dim excelapp As New Excel.Application
Dim excelfile As New Excel.Workbook
Dim excelsheet As New Excel.Worksheet
 
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, "query1", "C:\PED.xls", False
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, "query2", "C:\PED.xls", False
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, "query3", "C:\PED.xls", False
 
Set excelfile = excelapp.Workbooks.Open("C:\PED.xls")
 
Set excelsheet = excelfile.Worksheets.Item(1)
  excelsheet.Protect Password:="secret"
 
Set excelsheet = excelfile.Worksheets.Item(2)
  excelsheet.Protect Password:="secret"
 
Set excelsheet = excelfile.Worksheets.Item(3)
  excelsheet.Protect Password:="secret"
 
excelfile.Save
 
excelapp.ActiveWorkbook.Close True, "C:\PED.xls"
excelapp.Quit
 
Set excelsheet = Nothing
Set excelfile = Nothing
Set excelapp = Nothing

P.S. - I am referring to Code Lines 5-7.

[zmbd]

W/ADezii reply leads me towards one of two possiblities:
1) The c-drive root isn't available for read/write/execute
2) Excel has the VBA security set to inhibit automation.

I'm leaning towards the first as Win7 has a few new security features built-in... especially if this is a domain-group or enterprise/network connected PC. Networked PCs often have it set so that "normal" users can NOT normally write/modify directly to the C-Drive root "C:\", a lot of malware does this very thing. I know that when our company pushed the OS to Win7 a lot of my error routines started failing because I used to send these to a textfile at the local pc c-drive root level (long story; however, I could remote access the networked PC c-drive root at one point in time). When Win7 was installed, the error traps started to fail because they couldn't open the file for "write." Now I just have them emailed to the help desk - and they have no idea what to do with the email so they bounce it to my boss who then sends it to me (^-^)

So, the first step is to simply change the path to either a network or local location where you have read/write permisions... I suggest you use the application's current path. Line9 original code in Post#8 referenced in OP

The next thing I would do would be to set a check after line 12 in OP/second code block where you are setting the object
I would insert at line 13

 if excelfile is nothing then
    MsgBox prompt:="Creation of Excel Object Failed - Contact Support", Buttons:=vbCritical + vbOKOnly, Title:="Critical Error"
    Err.Raise vbObjectError + 513
End If

This should trap if the object hasn't been created for some reason.

Please let us know what happens from here.

[ADezii]

@zmbd:
The first possibility, as you have stated, can effectively be eliminated since, as quoted by the OP:

I'm using a code to export a query from Access to create a new Excel with 1 Sheet and Protect with password, and everything's right.

[Malungo1970]

Zmbd,

Thank You once again for the reply.

I tried to use the code, but the error is the same one.


@zmbd

[Malungo1970]

And I tried to change the local (Raiz) "C:\PED.xls" for "C:\TEST\PED.xls" and the error it was the same.

TKS

[zmbd]

@Malungo1970
Well so much for the OS easy fix.
Did you insert the code I gave you in my last post?
We need to make sure that the object is being created and opened properly first.
-IF, for some reason, like you have huge query, the file may not have finished at the OS level; thus, it is not yet available for write.
I Still suspect that there is something happening with the Win7-OS that is causing the issue, the code I provided should help to point that out.

[Malungo1970]

Zmdb,

Yes I inserted your code after line 12.

Thank You.

[zmbd]

So, must I assume that the code I asked you to insert didn't pop-up an "-2147220991(80040201) automation error" in that code and the VBA-Editor took you to the debug state?

[zmbd]

Try the following:

Private Sub botton_Click() 
    Dim excelapp As New Excel.Application
    Dim excelfile As New Excel.Workbook
    Dim excelsheet As New Excel.Worksheet
    Dim PathToFile As String
    On Error GoTo Err_botton_Click
    '
    'set the path
    PathToFile = CurrentProject.Path & "\ped.xlsx"
    '
    'Transfer the data to a workbook
    DoCmd.TransferSpreadsheet acExport, , "query1", PathToFile, False
    DoCmd.TransferSpreadsheet acExport, , "query2", PathToFile, False
    DoCmd.TransferSpreadsheet acExport, , "query3", PathToFile, False
    '
    'open the new workbook for modificaiton, if this fails then raise an errot
    Set excelfile = excelapp.Workbooks.Open(PathToFile)
    If excelfile Is Nothing Then Err.Raise vbObjectError + 513
    '
    'setup for protecting specfic worksheets within the workbook
    Set excelsheet = excelfile.Worksheets.Item(1)
    '
    'with mutiple worksheets, lets make sure we're dealing with only one worksheet.
    excelsheet.Select
    'and protect it
    excelsheet.Protect "secret"
    'do the next worksheet
    Set excelsheet = excelfile.Worksheets.Item(2)
    excelsheet.Protect Password:="secret"
    'and repeat
    Set excelsheet = excelfile.Worksheets.Item(3)
    excelsheet.Protect Password:="secret"
    '
    'Save the workbook
    excelfile.Save
    '
    'close the workbook and prepare for cleanup
    excelapp.ActiveWorkbook.Close True, PathToFile
    '
Exit_botton_Click:
    '
    'clean up any open references and free resouces.
    If Not excelsheet Is Nothing Then Set excelsheet = Nothing
    If Not excelfile Is Nothing Then Set excelfile = Nothing
    excelapp.Quit
    If Not excelapp Is Nothing Then Set excelapp = Nothing
Exit Sub
'
'Error trap.
Err_botton_Click:
    MsgBox Err.Number & " - " & Err.Description
    Resume Exit_botton_Click
End Sub

Please take note of the following:
Line 18: Best Practice to check that the external object is set
Line 24: If more than one worksheet is grouped, then the protect method will fail; thus, make sure only one worksheet is selected. This took a while to find as the error is somewhat generic and it takes a few trys to determine which object is tossing the error.
Line 40: Starting here is, IMHO, the best way to shut down your code... both with a normal execution and also in the event of an error. This order of commands should ensure that anything that has been set is cleared and that the excel application is freed from memory. Failure to do this can tie up system resources, cause data corruption, and is simply like feeding the Grimlins after mid-night.

BOL
-z

[Malungo1970]

Zmbd Thank You very Much,

Now the code is working.
The Point is

excelsheet.Select

I use "excelsheet.Select" in the lines 15, 18 and 21

Private Sub botton_Click()
On Error GoTo Err_botton_Click
 
Dim excelapp As New Excel.Application
Dim excelfile As New Excel.Workbook
Dim excelsheet As New Excel.Worksheet
 
DoCmd.TransferSpreadsheet acExport, , "query1", "C:\PED.xlsx", False
DoCmd.TransferSpreadsheet acExport, , "query2", "C:\PED.xlsx", False
DoCmd.TransferSpreadsheet acExport, , "query3", "C:\PED.xlsx", False
 
Set excelfile = excelapp.Workbooks.Open("C:\PED.xlsx")
 
Set excelsheet = excelfile.Worksheets.ITEM(1)
 excelsheet.Select
excelsheet.Protect Password:="secret"   
Set excelsheet = excelfile.Worksheets.ITEM(2)
 excelsheet.Select
excelsheet.Protect Password:="secret"
Set excelsheet = excelfile.Worksheets.ITEM(3)
 excelsheet.Select
excelsheet.Protect Password:="secret"
 
excelfile.Save
 
excelapp.ActiveWorkbook.Close True, "C:\PED.xlsx"
excelapp.Quit
 
Set excelsheet = Nothing
Set excelfile = Nothing
Set excelapp = Nothing
 
Exit_botton_Click:
Exit Sub
 
Err_botton_Click:
MsgBox Err.Number & " - " & Err.Description
Resume Exit_botton_Click
End Sub
 

Best wishes from Brazil.

[zmbd]

Yes, that was the final key once I was sure that there were no object creation/access issues which have for me in the past been the source.

You should not need the additional worksheet select statements unless you are going to modify the range values within the worksheet selected.

The first one at line 15 is enough to ensure that the worksheets are not grouped.

Shouldn't hurt anything, just adds unneeded cycles to the runtime execution.

Also, the way your code is written, versis what I posted, fails to release your resources in the event of an error. Might I suggest that you use the code I posted instead OR at least co-op the last section that handles the clean-up?!

Brazil... maybe the company will send me there one year... we have joint ventures... doubt it though... but we can dream of the beaches and the warm water.

off to bed with visions of sugar-plums in my head... been a very long day at my end of the world.

(Z_Z)