Results 1 to 3 of 3

Unlock VBA project using SendKeys.

This is a discussion on Unlock VBA project using SendKeys. within the Microsoft Access forums, part of the Question Forums category; I've got a 1000+ spreadsheets held within email attachments which I need to import into Access tables. Unfortunately they're not ...

  1. #1
    Board Regular Darren Bartrup's Avatar
    Join Date
    Mar 2006
    Location
    Nottingham (UK)
    Posts
    944

    Default Unlock VBA project using SendKeys.

    I've got a 1000+ spreadsheets held within email attachments which I need to import into Access tables.
    Unfortunately they're not in a format where I can easily import into Access (i.e. they're not in a list/table format).

    I've written the code to save the attachments to a folder, open the workbook, copy the relevant data to a table and then close & delete the workbook.

    The Workbook_BeforeClose event has code which saves the workbook before it closes though, and confirms this with the user by way of a messagebox... this code fires everytime the a workbook is closed. VERY annoying when there's so many workbooks to process. The code is also password protected.

    Now in hindsight, I would've taken better care when building this lot - i.e. trusted the users to save the workbook each time (yeah, right.... trust the user???!!!).

    I understand the only way to unprotect a VBA project is to use SendKeys, but this doesn't seem to be working. My code in Access isn't making Excel the active window I guess.

    The code I'm using is:
    Code:
                        '//Unprotect VBA for Workbook.
                        AppActivate "Microsoft Excel"
                        SendKeys "%{F11}"   'Open VBE
                        SendKeys "%T"       'Select Tools toolbar
                        SendKeys "%E"       'Select VBAProject Properties
                        SendKeys "MyPassword" 'Enter password into dialog box
                        SendKeys "{Enter}"  'Press OK
                        'RemoveAllCode XLApp
    But this isn't working - the idea is to unlock the code and delete the part that forces the workbook to save.

    Is this feasible? Or is there a way to stop the macro from running? I set the security to Very High, but as I wrote the code then it trusts me so it runs it anyway.

    Can I get at the data without opening the workbook - taking into account I need to access the cell references.

    My complete code is:
    Code:
    Sub Test()
        ExtractEmailAttachments "Mailbox - ASC Process Improvement Project", _
            "FAT Returns", "xls", "J:\BST\Systems\Projects\Functional Analysis Study\Returns"
    End Sub
    
    Sub ExtractEmailAttachments(InBoxFolder As String, OutlookSubFolder As String, _
        ExtString As String, DestFolder As String)
        Dim ns          As Namespace
        Dim MailBox     As MAPIFolder
        Dim Inbox       As MAPIFolder
        Dim SubFolder   As MAPIFolder
        Dim Item        As Object
        Dim Atmt        As Attachment
        Dim I           As Integer
        Dim FileName    As String
        Dim MyDocPath   As String
        Dim wsh         As Object
        Dim fs          As Object
        Dim XLApp       As Excel.Application
        Dim sSQL        As String
        
        '//Set references to email.
        Set ns = GetNamespace("MAPI")
        Set MailBox = ns.Folders(InBoxFolder)
        Set Inbox = MailBox.Folders("Inbox")
        Set SubFolder = Inbox.Folders(OutlookSubFolder)
    
        I = 0
        '//Check subfolder for messages and exit if none found.
        If SubFolder.Items.Count = 0 Then
            MsgBox "There are no messages in this folder: " & OutlookSubFolder, _
                vbInformation, "Nothing Found"
            Set SubFolder = Nothing
            Set Inbox = Nothing
            Set ns = Nothing
            Exit Sub
        End If
    
        '//Create DestFolder if DestFolder = ""
        If DestFolder = "" Then
            Set wsh = CreateObject("WScript.Shell")
            Set fs = CreateObject("Scripting.FileSystemObject")
            MyDocPath = wsh.specialfolders.Item("mydocuments")
            DestFolder = MyDocPath & "\" & Format(Now, "dd-mmm-yyyy hh-mm-ss")
            If Not fs.folderexists(DestFolder) Then
                fs.createfolder DestFolder
            End If
            Exit Sub
        End If
    
        If Right(DestFolder, 1) <> "\" Then
            DestFolder = DestFolder & "\"
        End If
        
        '//Create a new instance of the worker class.
        Dim Wrkr As clsWorker
        Set Wrkr = New clsWorker
            
        '//Check each message for attachments and extensions.
        For Each Item In SubFolder.Items
            For Each Atmt In Item.Attachments
                If LCase(Right(Atmt.FileName, Len(ExtString))) = LCase(ExtString) Then
                    '//Save file to DestFolder.
                    FileName = DestFolder & Item.SenderName & " " & Atmt.FileName
                    Atmt.SaveAsFile FileName
                    I = I + 1
                    '//Check if Excel is running and set a reference to it.
                    If IsAppRunning("Excel.Application") = False Then
                        Set XLApp = CreateObject("Excel.Application")
                    Else
                        Set XLApp = GetObject(, "Excel.Application")
                    End If
                    XLApp.Visible = True  'Comment out on final run.
                    With XLApp
                        '//Open workbook for data collection.
                        .Workbooks.Open FileName
                        With .ActiveWorkbook.Worksheets("MONDAY Analysis")
                            Wrkr.Name = .Cells(3, 3)
                            Wrkr.JobTitle = .Cells(3, 7)
                            Wrkr.Team = .Cells(4, 7)
                            Wrkr.ContractedHours = .Cells(4, 4)
                            Wrkr.TermTime = .Cells(5, 4)
                        End With
                        '//Insert details into database.
                        sSQL = "INSERT INTO tblWorkerDetails " & _
                            "VALUES ('" & Wrkr.Name & "', '" _
                            & Wrkr.JobTitle & "', '" _
                            & Wrkr.ContractedHours & "', '" _
                            & Wrkr.TermTime & "');"
                        DoCmd.SetWarnings False
                        DoCmd.RunSQL (sSQL)
                        DoCmd.SetWarnings True
                        
                        '//Unprotect VBA for Workbook.
                        AppActivate "Microsoft Excel"
                        SendKeys "%{F11}"   'Open VBE
                        SendKeys "%T"       'Select Tools toolbar
                        SendKeys "%E"       'Select VBAProject Properties
                        SendKeys "MyPassword" 'Enter password into dialog box
                        SendKeys "{Enter}"  'Press OK
                        'RemoveAllCode XLApp
                        '//Close workbook.
    '                    .ActiveWorkbook.Close
    '                    Kill FileName
                    End With
                End If
            Next Atmt
        Next Item
    
    
    End Sub
    
    Function IsAppRunning(ByVal sAppName) As Boolean
        Dim oApp As Object
        On Error Resume Next
        Set oApp = GetObject(, sAppName)
        If Not oApp Is Nothing Then
            Set oApp = Nothing
            IsAppRunning = True
        End If
    End Function
    Class Module:
    Code:
    Private pWrkrName           As String
    Private pWrkrTitle          As String
    Private pWrkrTeam           As String
    Private pContractedHrs      As Double
    Private pTermTime           As String
    
    '//Name property
    Public Property Get Name() As String
        Name = pWrkrName
    End Property
    Public Property Let Name(Value As String)
        pWrkrName = StrConv(Value, vbProperCase)
    End Property
    
    '//Job Title property
    Public Property Get JobTitle() As String
        JobTitle = pWrkrTitle
    End Property
    Public Property Let JobTitle(Value As String)
        pWrkrTitle = Value
    End Property
    
    '//Worker Team property
    Public Property Get Team() As String
        Team = pWrkrTeam
    End Property
    Public Property Let Team(Value As String)
        pWrkrTeam = Value
    End Property
    
    '//Contracted Hours property
    Public Property Get ContractedHours() As Double
        ContractedHours = pContractedHrs
    End Property
    Public Property Let ContractedHours(Value As Double)
        pContractedHrs = Value
    End Property
    
    '//Term Time property
    Public Property Get TermTime() As String
        TermTime = pTermTime
    End Property
    Public Property Let TermTime(Value As String)
        pTermTime = Value
    End Property
    Any help greatly appreciated!!
    Darren.
    Using Office 2003, 2007 & 2010,

    I'm 1 of the 10 people that don't understand binary. Guess that means the other 1001 do.

    No answer to your post?
    Get someone to read it - does it make sense or does it sound like gibberish?

  2. #2
    MrExcel MVP CT Witter's Avatar
    Join Date
    Jul 2002
    Location
    Columbus, OH
    Posts
    1,208

    Default Re: Unlock VBA project using SendKeys.

    Try Application.EnableEvents = False to disable the excel macro from firing

  3. #3
    Board Regular Darren Bartrup's Avatar
    Join Date
    Mar 2006
    Location
    Nottingham (UK)
    Posts
    944

    Default Re: Unlock VBA project using SendKeys.

    Hadn't thought of that one.

    I'll try it tomorrow at work.
    Thanks.
    Darren.
    Using Office 2003, 2007 & 2010,

    I'm 1 of the 10 people that don't understand binary. Guess that means the other 1001 do.

    No answer to your post?
    Get someone to read it - does it make sense or does it sound like gibberish?

Like this thread? Share it with others

Like this thread? Share it with others

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  


DMCA.com