Select and import a password protected excel file.

I have an access database that the user imports imports excel spreadsheets into each week.  There are about 20 excel files in different directories and they are all password protected.  

Does anyone have the VB code or a macro that can be used to automate this process?

Thanks

Marshall
LVL 3
mvarner2000Asked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Patrick MatthewsCommented:
Hi Marshall,

TransferSpreadsheet will bomb on a password-protected workbook.

I would set thing up in a loop, and before importing the data opening each workbook, removing the password, running
TransferSpreadsheet, and then reapplying the password.  This shows how to process one file:


Sub test()

    Dim xlApp As Object
    Dim xlWb As Object
   
    Set xlApp = CreateObject("Excel.Application")
   
    Set xlWb = xlApp.Workbooks.Open(FileName:="C:\folder\test.xls", Password:="test")
    xlWb.Password = ""
    xlWb.Close True
   
    DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, "test", "C:\folder\test.xls", True

    Set xlWb = xlApp.Workbooks.Open(FileName:="C:\folder\test.xls")
    xlWb.Password = "test"
    xlWb.Close True

    Set xlWb = Nothing

    xlApp.Quit
    Set xlApp = Nothing

End Sub

This can be extended to do what you need, if you provide some more details.

Regards,

Patrick
jefftwilleyCommented:
There's quite a lot to this.
You're going to have to use Excel automation. (VBA code)
You're going to have to build an interface (form) to kick this process off
you'll need to know the directories and create a way to browse for them. then store the path's
you're going to have to build a table to house all the Excel Passwords to pass to your excel automation
You're going to have to define all the tables and fields to store the incoming data
You'll need to probably build a temp table, and set of queries to put the imported data into your main table

This is a good start.....you think you have enough info at hand to start all this? What's your knowledge level?
J
mvarner2000Author Commented:
Thanks Guys

I hope this will get me started.  Looks like the hardest part is going to be building a form that will allow me to browse for the spread sheets I need to import.  The password is going to be the same for all the files so I should b e able to hardcode it somehow.

I have worked a great deal with Access but I am an advanced novis in VB.  I will look this over this weekend and let you know what I come up with.


Marshall
Why Diversity in Tech Matters

Kesha Williams, certified professional and software developer, explores the imbalance of diversity in the world of technology -- especially when it comes to hiring women. She showcases ways she's making a difference through the Colors of STEM program.

Patrick MatthewsCommented:
Marshall,

If the files will always be in the same directories with the same names, then I would set up a table:

tblExcel
--------------------------------------------------------------------------
PathAndFileName
Password
ImportIntoTable

Then open an ADO or DAO recordset and use the values to power TransferSpreadsheet.

Patrick
mvarner2000Author Commented:
The files will be in multiple directories which could change but not to often but the file names are date specific and change each week.

Marshall
jefftwilleyCommented:
Marshall,
Are all the files the same layout? Same field names and types? You might start with going into one of your spreadsheets and unlocking it then saving and closing. You can put the password protection back in once you're done. Use Access's Link Table function to link the Excel Spreadsheet so that it appears in your database as a table. You can then use a MakeTable Query to create the Table you're going to need to populate when you use the Transfer Spreadsheet method. Once the table is created, you can delete the linked excel table. This will give you a starting point for your import and give you some text to play around with to make sure all your data types in your table are correct.
J
jefftwilleyCommented:
I'm pasting in some code you can copy and paste into a module. This code will work with your form to allow you to browse for your files. There is one place you'll need to make a change, and I commented it in bold. First is to create a form Call it whatever you want. Put a button on the form. This button will be the FunctionCall for the function. Create a text box on your form and call it txtPathFile. When you push the button, it will open a browser window. Go find your file and click ok (or save..whatever) and it puts the full path into the text box. Then you can use the value in the text box into your transfer spreadsheet code.

On your button's On_Click event, paste this

=OpenDialogBox("txtPathFile")


Next, Paste this into a module
------------------------------------------------------------------------------------------------------------------------------
Global strExportPathAndFileName As String
' GetOpenFileName Declaration
    Declare Function Open_File_Name_Dialog_Box Lib "comdlg32.dll" Alias "GetOpenFileNameA" (pOpenfilename As OpenFilename) As Long
' OpenFileName Structure
    Type OpenFilename
        lStructSize As Long
        hwndOwner As Long
        hInstance As Long
        lpstrFilter As String
        lpstrCustomFilter As String
        nMaxCustFilter As Long
        nFilterIndex As Long
        lpstrFile As String
        nMaxFile As Long
        lpstrFileTitle As String
        nMaxFileTitle As Long
        lpstrInitialDir As String
        lpstrTitle As String
        Flags As Long
        nFileOffset As Integer
        nFileExtension As Integer
        lpstrDefExt As String
        lCustData As Long
        lpfnHook As Long
        lpTemplateName As String
    End Type

Public Function OpenDialogBox(strSource As String)
' Enable error handler for this routine
    On Error GoTo err_OpenDialogBox
' Dimension a variable for the return value of GetOpenFileName
    Dim ReturnValue As Long
    Dim strFullPath As String
    Dim lnImportType As Long
' Dimension a Variable Of the OPENFILENAME type
    Dim Open_File_Name_Structure As OpenFilename
' Dimension variables used for filters
    Dim strFilter1 As String, strFilter2 As String, Filter As String, strIDir As String
' Set the filters
    strFilter1 = "Select the CLICK ME File(*.txt)" + Chr$(0) + "*.txt" + Chr$(0)
    strFilter2 = "All files (*.*)" + Chr$(0) + "*.*" + Chr$(0)
    Filter = strFilter1 + strFilter2 + Chr$(0)
' Assign the structure members
        Open_File_Name_Structure.lStructSize = Len(Open_File_Name_Structure)
        Open_File_Name_Structure.hwndOwner = Screen.ActiveForm.hWnd
        Open_File_Name_Structure.lpstrFilter = Filter
        Open_File_Name_Structure.nFilterIndex = 1
        Open_File_Name_Structure.lpstrFile = Chr$(0) & Space$(255) & Chr$(0)
        Open_File_Name_Structure.nMaxFile = 10000
        Open_File_Name_Structure.lpstrFileTitle = Chr$(0) & Space$(255) & Chr$(0)
        Open_File_Name_Structure.nMaxFileTitle = 10000
        Open_File_Name_Structure.lpstrDefExt = ".xls" & Chr$(0)
        Open_File_Name_Structure.lpstrInitialDir = CurDir$ + Chr$(0)
        Open_File_Name_Structure.nFileOffset = 0
        Open_File_Name_Structure.nFileExtension = 0
        Open_File_Name_Structure.lpstrTitle = "Select a File"
' Call the function to open the DialogBox
    ReturnValue = Open_File_Name_Dialog_Box(Open_File_Name_Structure)
' Put the Path and File Name onto the form
    strFullPath = Left(Open_File_Name_Structure.lpstrFile, InStr(Open_File_Name_Structure.lpstrFile, Chr$(0)) - 1)
    Select Case strSource
    Case "txtPathFile"
        Forms!YOURFORM(strSource).Value = strFullPath '<-----------------------------WILL NEED YOUR FORM'S NAME HERE
    End Select
' Exit the Function
    Exit Function
' Error handler for this routine
err_OpenDialogBox:
    Select Case Err
        Case 3315
            Exit Function
        Case Else
            MsgBox "Function modOpen_Dialog_Box_Code.OpenDialogBox." & vbCrLf & "You have error number " & Err & ".  " & Err.Description
    End Select
End Function
------------------------------------------------------------------------------------------------------------------------------------------------------------------

You can play with this for a bit until you get comfortable. I left a select statement where you have to change your Form's name in case you wanted to use this function from a different form or a different button. Let me or Patrich know if you have any questions so far.
J
Patrick MatthewsCommented:
Marshall,

> The files will be in multiple directories which could change but not to often but the file names are
> date specific and change each week.

Then my approach should still work--we just need to be a little more clever :)

Patrick
jefftwilleyCommented:
If it helps, Here's some code that reads through a given directory and picks up all Excel files for import in a loop. It uses stored paths that are selected initially from a form using the same code above. I think we could incorporate Patrick's Automation to "unlock" each one to make it all work.

The names would have to be changed of course, but hopefully it will get you pointed where you need to go.

Public Function LoopThroughPath()
' This function will use the directory path and import all files matching the criteria
Dim strPath As String
Dim strFile As String
Dim myFullFile As String
Dim strTable As String
Dim strDest As String
    strTable = "ExcelUpload"
    strPath = DLookup("ExcelSourceDir", "tbl_ExcelDir")   ' Set the path for the Source Directory.
    strDest = DLookup("ExcelSaveDir", "tbl_ExcelDir") ' Set the path for the Save Directory.
    strFile = Dir(strPath, vbDirectory)
    Do While strFile <> ""
        If Right(strFile, 4) = ".xls" Then ' Criteria, ie File Extension
            myFullFile = strPath & strFile
            DoCmd.SetWarnings False
            'Here I will want to delete any old linked spreadsheet if it exists
            If TableExists(strTable) Then
                DoCmd.DeleteObject acTable, strTable
            End If
            'Now I link to the selected spreadsheet
            DoCmd.TransferSpreadsheet acLink, 8, strTable, myFullFile, True, ""
            'Here I want to run the append query
            DoCmd.OpenQuery "qryAppendDaily"
            ' Here I want to delete the linked spreadsheet
            If TableExists(strTable) Then
                DoCmd.DeleteObject acTable, strTable
            End If
            DoCmd.SetWarnings True
            'Now I want to move the selected excel file to the "done" directory
            FileCopy myFullFile, strDest & strFile
            Kill myFullFile
        End If
        strFile = Dir()
    Loop
    'now move the files from the import table to the target tables and empty the temp table
    DoCmd.SetWarnings False
    DoCmd.OpenQuery "Shannon Cat Import Query"
    DoCmd.OpenQuery "Shannon Daily Import Query"
    'DoCmd.RunSQL "delete * from [Daily Claims Import];"
    DoCmd.SetWarnings True
End Function

-----------------------------------------------------------------------------------------------
Function TableExists(ByVal TName$) As Boolean

    On Error Resume Next
    Dim db As Database, rs As Recordset, I%
    Set db = CurrentDb
    For I = 0 To db.TableDefs.Count - 1
        If db.TableDefs(I).name = TName Then
            TableExists = True
            Exit For
        End If
    Next

End Function

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Access

From novice to tech pro — start learning today.