Module to import Multiple workbooks when Sheet is password protected

[DoctorV3774 via AccessMonster.com]

I have the following function which works great. It imports every workbook
in the folder path listed and appends it into Tbl_Data.

I just need to make some adjustments for this.

How can I adjust this IF
1) the Workbook and/or the Sheet is Password protected
2) range in hidden sheet
3) there are multiple sheets

Any assistance most appreciated!!!!!




Function ImportFireFighterForms()
'Change field names in Tbl_Data to F1, F2 etc
'Change the strPath to the path location of the files._
'If you need to add more columns Add addional F8, F9 fields as Text 255
or memo in Tbl_Data
'Change DBOutput!A2:H2 to more columns if necessary
'Set references to DAO 3.6 Library and Excel Library
Dim strPath As String
Dim strFile As String
On Error Resume Next
strPath = "C:\FireFighterForm\"
strFile = Dir(strPath & "*.xls")

While strFile <> ""
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9,
"tbl_Data", strPath & strFile, False, "DBOutput!A2:h2"
strFile = Dir()
Wend
End Function

 

[DoctorV3774 via AccessMonster.com]

Here is the function that works

Function ImportFireFighterForms()
'Change the strPath to the path location of the files._
'If you need to add more columns Add addional F8, F9 fields as Text 255
in Tbl_Data
'Change DBOutput!A2:H2 to more columns if necessary
'Set references to DAO 3.6 Library and Excel Library
On Error GoTo ErrHandle_Err
Dim Msg, Style, Title, Help, Ctxt, Response, MyString
Msg = "Do you want to Import the Excel Files ?" ' Define message.
Style = vbYesNo + vbCritical + vbDefaultButton2 ' Define buttons.
Title = "MsgBox Demonstration" ' Define title.
Help = "DEMO.HLP" ' Define Help file.
Ctxt = 1000 ' Define topic
' context.
' Display message.
Response = MsgBox(Msg, Style, Title, Help, Ctxt)
If Response = vbYes Then ' User chose Yes.
Dim strPath As String
Dim strFile As String
Dim oExcel As Excel.Application, oWb As Excel.Workbook
Dim oBooks As Excel.Workbooks

'On Error Resume Next

strPath = "C:\FireFighterForm\"

strFile = Dir(strPath & "*.xls")
On Error Resume Next
Set oExcel = GetObject(, "Excel.Application")
If Err.Number <> 0 Then
Set oExcel = CreateObject("Excel.Application")
End If
On Error GoTo 0
oExcel.Visible = False
oExcel.ScreenUpdating = False
Set oBooks = oExcel.Workbooks

While strFile <> ""
Set oWb = oBooks.Open(Filename:=strPath & strFile, Password:="Test")

DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9,
"tbl_Data", strPath & strFile, False, "DBOutput!A2:i2"
oWb.Close SaveChanges:=False
Set oWb = Nothing
strFile = Dir()
Wend
oBooks.Close
Set oBooks = Nothing
oExcel.Quit
Set oExcel = Nothing
MsgBox "Job Complete"
'DoCmd.TransferSpreadsheet acImport, _
acSpreadsheetTypeExcel9, "Import", strFile, -1

Else ' User chose Cancel.
DoCmd.CancelEvent ' Perform some action.
End If
ErrHandle_Exit:
Exit Function

ErrHandle_Err:
MsgBox Error$
Resume ErrHandle_Exit

End Function