Open Password protected XLS which has an Autoexec macro

brq123

Brian
Local time
Today, 04:55
Joined
Feb 15, 2008
Messages
2
How do you to set up VBA code to read data from an Excel workbook that has a password on the workbook and an autoexec macro that requests another password? The following code works if the Excel spreadsheet is not protected.

DoCmd.TransferSpreadsheet transfertype:=acImport, SpreadsheetType:=5, _
tablename:="tbl_Temp_Import_Of_TimeSheets", FileName:=strTimeSheetName, _
Hasfieldnames:=False, Range:="Input Sheet!A1:AZ5202"


Opening the file using

xlApp2.Visible = True
strTimeSheetName = "C:\data\500685.xls"
xlApp2.Workbooks.Open FileName:=strTimeSheetName, _
Password:=" 123456789 "


does not work as the system sits waiting for the user input.
 
I don't think you can import a password protected spreadsheet but I could be wrong. You will probably have to use vba to to open the sheet and process it row by row.
 
A further search of this forum gave me the answer which I have repeated below.

Option Compare Database
Public xlapp As New Excel.Application

Public Sub ImportAll()
Dim strPath As String
Dim strFileName As String
Dim strPass As String

strPath = "G:\C\B\T\" 'Set Path
strFileName = Dir(strPath & "*.xls") 'Set first file

Do
On Error GoTo ErrTrp

DoCmd.TransferSpreadsheet acImport, 8, "Test 2", strPath & strFileName, True, "Access_Upload!C13:L34"

ErrTrp:
If Err.Number = 3161 Then 'Encription error so unprotect workbook
xlapp.Visible = False 'Open Excel
xlapp.EnableEvents = False 'Disable Events (Macro's)
xlapp.workbooks.Open strPath & strFileName 'Open File
xlapp.ActiveWorkbook.Unprotect (strPass) 'Unprotect

'Try and Import again
DoCmd.TransferSpreadsheet acImport, 8, "Test 2", strPath & strFileName, True, "Access_Upload!C13:L34"

xlapp.ActiveWorkbook.Protect (strPass) 'protect
xlapp.ActiveWorkbook.Save 'Save
xlapp.EnableEvents = True 'Enable Events
xlapp.ActiveWorkbook.Close 'Close File
xlapp.Quit 'Quit Excel

Else
End If

strFileName = Dir() 'look for next file

If strFileName = "" Then 'no more files
Exit Do
End If

Loop
 

Users who are viewing this thread

Back
Top Bottom