Microsoft Office – CJSmith dot me

Credits (As what I consider the hard stuff was actually done by other people):
TheSmileyCoder for the solid awesome little VBS File, this basically gets around the limitation of not actually getting Access to load another Access Database. At the time I only ever needed one modification (A rarely issue affected two P4 machines with a 5400RPM drive and bloated AV software). More than likely WScript.Sleep(200) won’t be required and the original file can be used.
UtterAccess for the AddTrustedLocation code.
AccessMVP as for this loader I tend to use the DSNLESS code to remove the need to deploy yet another ODBC link to user machines.
VBA Tips and Tricks for the FileExists module.

About:
The following contains what I call the Microsoft Access 2010 Loader. It was put together to try and stop heavily used Microsoft Access database front ends from corrupting (We had a point where one particular Access front end would be corrupted up to 3 or 4 times a day as around 40 to 50 people would be in a 40MB Access front end at any time). The included version will require the table to be linked to a database, we use a central SQL database.
This access file will treat its own filename as the file it will launch, so be aware the loader and your actual access front ends needs to be located in different places.

What does it do:
It checks if a copy of the Access front end and VBS file exists locally (I use the %appdata% folder, you may want to use another location or %localappdata% instead)
If it exists it checks if the version in registry (HKEY_LOCAL_USER\Software\VB and VBA Program Settings\\Version\Version) matches what is in the database table “dbo_access_version_master”
If it doesn’t exist locally or the version does not match it then downloads from a location such as “\\myserver\access$\”
If downloaded the registry is updated with the new version number
It then passes parameters to a VBS file created by TheSmileyCoder and launches it

Limitations:
The first form of the called Access file MUST have VBA code of some sort or else the Access file simply closes.
I haven’t found a way to detect if a local copy of an Access ACCDR file has corrupt VBA.
I have found users copy and rename the loaders file breaking it, try and ensure shortcuts are used.
I haven’t been able to trap where Windows AD accounts have expired or locked, as the error occurs when Access connects to our central SQL database.
If the locations aren’t added to the Trusted Locations the user will be prompted twice to allow the Access files to open. The loader uses code to add this on first launch.
I sometimes find the repaints don’t always work.
Looking at the code used its a bit horrible looking, more than likely it can be optimized much better.

What do I need to change in VBA (Alt + F11):
Replaced in the VBA code “MyCompany” with your own on the main form and module SwitchFrontEnd.
Replace \\myserver\access$\ with where you will store your files (I used access$ as this is hidden if someone views the server)
If you don’t use .accdr files replace .accdr on the forms code

The actual files:
Microsoft Access Loader Files

Posted In Access 2010 | Visual Basic for Applications

This Outlook 2010 VBA code was used to impose a time when emails could not be sent and were instead delayed until the next work day.
This was put together (Credits go to key parts of this VBA are in the actual code) because the Managing Director where I work realised he was making people work outside of their core hours.
The script however will send emails if the email is set to high priority or if a user is in the email group “Send_at_all_times”.
Restrictions include having to sign the code (Otherwise Outlook VBA security has to be lowered), the other is since the code doesnt do anything fancy it will always send if someone it sends to is in the group “Send_at_all_times”.

This has only been tested in Microsoft Outlook 2010 on Windows 7.

Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
On Error GoTo Err_Application_ItemSend
 
'Credits for core script is https://www.mikesel.info/delay-outlook-mail-sending/
'and http://www.vbforums.com/showthread.php?574491-RESOLVED-Outlook-VB-Macro-Deffered-Delivery-Time
'Credits for dist group grab is http://blogs.technet.com/b/heyscriptingguy/archive/2007/03/27/how-can-i-list-all-the-members-of-a-microsoft-outlook-distribution-list.aspx
'This script is to delay emails until the next working day if outside of reasonable hours.  The script can be bypassed by sending emails with the importance level of HIGH
'There is also a group lookup to also always send if in this group.
    Dim obj As Object
    Dim Mail As Outlook.MailItem
    Dim WkDay, SendNow, SendtoAddress As String
    Dim MinNow, SendHour As Integer
    Dim SendDate As Date
    Dim emailItem As Outlook.MailItem
    Dim objOutlook, objNamespace, objDistList, colContacts As Object
    Dim i, j, intCount As Integer
    Dim groupaddresses() As String
'Grab list of contacts from Dist Group, done after importance check as important emails don't require this check anyway
    Const olFolderContacts = 10
    Set objOutlook = CreateObject("Outlook.Application")
    Set objNamespace = objOutlook.GetNamespace("MAPI")
    Set colContacts = objNamespace.GetDefaultFolder(olFolderContacts).Items
'Grab email address being sent to
    Set emailItem = Application.ActiveInspector.CurrentItem
        SendtoAddress = emailItem.To
'MsgBox colContacts.Count & SendtoAddress
'Grab amount of users in email group and redim array
        Set objDistList = colContacts.Item("Send_at_all_times")
        ReDim groupaddresses(objDistList.MemberCount)
        SendNow = "N"
'Added a limit of intCount users to try and prevent any unexpected looping issues
        i = 1
            For j = 1 To objDistList.MemberCount
                groupaddresses(j) = objDistList.GetMember(j).Name
'If address does not match anything in group address run code below otherwise skip
        If InStr(1, SendtoAddress, groupaddresses(j), 1) = 0 Then
'Should never happen but just in case trap going over member count to prevent an endless loop!
                    If i <= objDistList.MemberCount Then
                        i = i + 1
                    Else
'This error should never occur!!  Bail out of For loop to prevent endless loop.
                        MsgBox "Failed! More than " & objDistList.MemberCount & "users are in this group"
                            Exit For
                    End If
        Else
'Set SendNow to Yes as a match was found
            SendNow = "Y"
                Exit For
        End If
            Next
'Check if email is set to Normal or low importance
'Our requirement is for anything set to important to always send immediately, if not required comment out the if statement and the associated end if
    If emailItem.Importance <> olImportanceHigh And SendNow = "N" Then
'Code to check whether email needs to be delayed
'Set Variables
SendDate = Now()
SendHour = Hour(Now)
MinNow = Minute(Now)
WkDay = Weekday(Now)
SendNow = "Y"
'Check if Before 8am
If SendHour < 8 Then
    SendHour = 8 - SendHour
    SendDate = DateAdd("h", SendHour, SendDate)
    SendDate = DateAdd("n", -MinNow, SendDate)
    SendNow = "N"
End If
'Check if after on or after 7PM
If SendHour >= 19 Then           'After 7 PM amended to >=
    SendHour = 32 - SendHour    'Send a 8 am next day
    SendDate = DateAdd("h", SendHour, SendDate)
    SendDate = DateAdd("n", -MinNow, SendDate)
    SendNow = "N"
End If
'Check if Sunday
If WkDay = 1 Then
    SendHour = 8 - SendHour
    SendDate = DateAdd("d", 1, SendDate)
    SendDate = DateAdd("h", SendHour, SendDate)
    SendDate = DateAdd("n", -MinNow, SendDate)
    SendNow = "N"
End If
'Check if Saturday
If WkDay = 7 Then
    SendHour = 8 - SendHour
    SendDate = DateAdd("d", 2, SendDate)
    SendDate = DateAdd("h", SendHour, SendDate)
    SendDate = DateAdd("n", -MinNow, SendDate)
    SendNow = "N"
End If
'Send the Email or Queue it if variable SendNow = N
  Set obj = Application.ActiveInspector.CurrentItem
  If TypeOf obj Is Outlook.MailItem Then
    Set Mail = obj
    'Check if we need to delay delivery
    If SendNow = "N" Then
      Mail.DeferredDeliveryTime = SendDate
    End If
    'Mail.Send
  End If
'End if for date checks
        Else
        End If
Err_Application_ItemSend_Exit:
'Destroy Variables
    Exit Sub
Err_Application_ItemSend:
    'MsgBox Error$
    Resume Err_Application_ItemSend_Exit
End Sub

100

101

102

103

104

105

106

107

108

109

110

Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)

On Error GoTo Err_Application_ItemSend

'Credits for core script is https://www.mikesel.info/delay-outlook-mail-sending/

'and http://www.vbforums.com/showthread.php?574491-RESOLVED-Outlook-VB-Macro-Deffered-Delivery-Time

'Credits for dist group grab is http://blogs.technet.com/b/heyscriptingguy/archive/2007/03/27/how-can-i-list-all-the-members-of-a-microsoft-outlook-distribution-list.aspx

'This script is to delay emails until the next working day if outside of reasonable hours. The script can be bypassed by sending emails with the importance level of HIGH

'There is also a group lookup to also always send if in this group.

Dim obj As Object

Dim Mail As Outlook.MailItem

Dim WkDay, SendNow, SendtoAddress As String

Dim MinNow, SendHour As Integer

Dim SendDate As Date

Dim emailItem As Outlook.MailItem

Dim objOutlook, objNamespace, objDistList, colContacts As Object

Dim i, j, intCount As Integer

Dim groupaddresses() As String

'Grab list of contacts from Dist Group, done after importance check as important emails don't require this check anyway

Const olFolderContacts = 10

Set objOutlook = CreateObject("Outlook.Application")

Set objNamespace = objOutlook.GetNamespace("MAPI")

Set colContacts = objNamespace.GetDefaultFolder(olFolderContacts).Items

'Grab email address being sent to

Set emailItem = Application.ActiveInspector.CurrentItem

SendtoAddress = emailItem.To

'MsgBox colContacts.Count & SendtoAddress

'Grab amount of users in email group and redim array

Set objDistList = colContacts.Item("Send_at_all_times")

ReDim groupaddresses(objDistList.MemberCount)

SendNow = "N"

'Added a limit of intCount users to try and prevent any unexpected looping issues

i = 1

For j = 1 To objDistList.MemberCount

groupaddresses(j) = objDistList.GetMember(j).Name

'If address does not match anything in group address run code below otherwise skip

If InStr(1, SendtoAddress, groupaddresses(j), 1) = 0 Then

'Should never happen but just in case trap going over member count to prevent an endless loop!

If i <= objDistList.MemberCount Then

i = i + 1

Else

'This error should never occur!! Bail out of For loop to prevent endless loop.

MsgBox "Failed! More than " & objDistList.MemberCount & "users are in this group"

Exit For

End If

Else

'Set SendNow to Yes as a match was found

SendNow = "Y"

Exit For

End If

'Check if email is set to Normal or low importance

'Our requirement is for anything set to important to always send immediately, if not required comment out the if statement and the associated end if

If emailItem.Importance <> olImportanceHigh And SendNow = "N" Then

'Code to check whether email needs to be delayed

'Set Variables

SendDate = Now()

SendHour = Hour(Now)

MinNow = Minute(Now)

WkDay = Weekday(Now)

SendNow = "Y"

'Check if Before 8am

If SendHour < 8 Then

SendHour = 8 - SendHour

SendDate = DateAdd("h", SendHour, SendDate)

SendDate = DateAdd("n", -MinNow, SendDate)

SendNow = "N"

End If

'Check if after on or after 7PM

If SendHour >= 19 Then 'After 7 PM amended to >=

SendHour = 32 - SendHour 'Send a 8 am next day

SendDate = DateAdd("h", SendHour, SendDate)

SendDate = DateAdd("n", -MinNow, SendDate)

SendNow = "N"

End If

'Check if Sunday

If WkDay = 1 Then

SendHour = 8 - SendHour

SendDate = DateAdd("d", 1, SendDate)

SendDate = DateAdd("h", SendHour, SendDate)

SendDate = DateAdd("n", -MinNow, SendDate)

SendNow = "N"

End If

'Check if Saturday

If WkDay = 7 Then

SendHour = 8 - SendHour

SendDate = DateAdd("d", 2, SendDate)

SendDate = DateAdd("h", SendHour, SendDate)

SendDate = DateAdd("n", -MinNow, SendDate)

SendNow = "N"

End If

'Send the Email or Queue it if variable SendNow = N

Set obj = Application.ActiveInspector.CurrentItem

If TypeOf obj Is Outlook.MailItem Then

Set Mail = obj

'Check if we need to delay delivery

If SendNow = "N" Then

Mail.DeferredDeliveryTime = SendDate

End If

'Mail.Send

End If

'End if for date checks

Else

End If

Err_Application_ItemSend_Exit:

'Destroy Variables

Exit Sub

Err_Application_ItemSend:

'MsgBox Error$

Resume Err_Application_ItemSend_Exit

End Sub

Posted In Outlook 2010 | Visual Basic for Applications

CJSmith dot me

I dump stuff I find useful here

Category: Microsoft Office

Microsoft Access 2010 loader

Why use ACCDE and then ACCDR Access Front Ends

Outlook 2010: VBA delay sending of emails until the next working day if outside of reasonable hours