Thursday, March 15, 2018

Create and/or update Outlook contacts from Excel

When you have a good overview of all your contact details in an Excel file, it can be useful to exportExcel_2007 these towards Outlook (eg to allow automatic synchronization towards your mobile). When including contact pictures, the look and feel of Outlook and your mobile increases a lot by immediately showing the related pictures when receiving a mail or call.

Since the contact details can change over time, I created the Excel macro below to update existing contacts and create the non existing contact within Outlook, including all available details of the contact.

Using a ‘Reference’ sheet, in which the columns are references using a named cell, it’s easy to retrieve the contact details from the right column, while still being able to easily change the data or order. The data is retrieved using the Cells.Range option, eg: Sheets(sheetName).Cells(i, Sheets("References").Range("columnname").Value)

In order to make sure the same contact is not added multiple times, the contact is first retrieved from the available Outlook contacts using the olFolder.Item.Restrict(…filter…) option based on the email address of the contact.

Since I load the contact details from a DB using a linked Query within Excel, I also refresh the query data before performing the migration from Excel to Outlook.

All details can be found in the macro source below and the example Excel file (including the macro).

'Developed by myT, http://myTselection.blogspot.com
Option Explicit


Public Sub RefreshQueries()

  Dim wks As Worksheet
  Dim qt As QueryTable
  Dim lo As ListObject

  For Each wks In Worksheets
    For Each qt In wks.QueryTables
        qt.Refresh BackgroundQuery:=False
    Next qt

    For Each lo In wks.ListObjects
        lo.QueryTable.Refresh BackgroundQuery:=False
    Next lo

  Next wks

  Set qt = Nothing
  Set wks = Nothing
End Sub
'http://www.globaliconnect.com/excel/index.php?option=com_content&view=article&id=167:import-contacts-from-excel-to-outlook-automate-in-vba&catid=79&Itemid=475



Sub ExcelWorksheetDataAddToOutlookContacts()
    'Automating Outlook from Excel: This example uses the Items.Add Method to export data from an Excel Worksheet to the default Contacts folder.
    'Automate Outlook from Excel, using Late Binding. You need not add a reference to the Outlook library in Excel (your host application), in this case you will not be able to use the Outlook's predefined constants and will need to replace them by their numerical values in your code.
    
    
    
    Dim oApplOutlook As Object
    Dim oNsOutlook As Object
    Dim oCFolder As Object
    Dim oDelFolder As Object
    Dim oCItem As Object
    'Dim olItems As Outlook.Items
    Dim olItems As Object
    'Dim olContactItem As contactItem
    Dim olContactItem As Object
    Dim oDelItems As Object
    Dim lLastRow As Long, i As Long, n As Long, c As Long
    Dim firstRowToProcess As Integer, emailColumn As Integer, pictureColumn As Integer, processedColumn As Integer, itemsFound As Integer
    Dim sheetName As String, fullFilePath As String
    Dim updateExistingContacts As Boolean
    
    
    RefreshQueries
    
    'Config:
    sheetName = "Contacts"
    firstRowToProcess = 2
    updateExistingContacts = False
    
    updateExistingContacts = MsgBox("Update and overwrite fields of existing contacts? Pictures will always be updated. (Existing notes will be appended, not overwritten)", vbYesNo, "Overwrite")
    
    
   Application.ScreenUpdating = False
    ' turns off screen updating
    Application.DisplayStatusBar = True
    ' makes sure that the statusbar is visible
    Application.StatusBar = "Preparing export contacts to Outlook"
    
    'determine last data row in the worksheet:
    lLastRow = Sheets(sheetName).Cells(Rows.Count, "A").End(xlUp).Row
    
    'Create a new instance of the Outlook application, if an existing Outlook object is not available.
    'Set the Application object as follows:
    On Error Resume Next
    Set oApplOutlook = GetObject(, "Outlook.Application")
    'if an instance of an existing Outlook object is not available, an error will occur (Err.Number = 0 means no error):
    If Err.Number <> 0 Then
        Set oApplOutlook = CreateObject("Outlook.Application")
    End If
    'disable error handling:
    On Error GoTo 0
    
    'use the GetNameSpace method to instantiate (ie. create an instance) a NameSpace object variable, to access existing Outlook items. Set the NameSpace object as follows:
    Set oNsOutlook = oApplOutlook.GetNamespace("MAPI")
    
    '----------------------------
    
    'Empty the Deleted Items folder in Outlook so that when you quit the Outlook application you bypass the prompt: Are you sure you want to permanently delete all the items and subfolders in the "Deleted Items" folder?
    
    'set the default Deleted Items folder:
'    'The numerical value of olFolderDeletedItems is 3. The following code has replaced the Outlook's built-in constant olFolderDeletedItems by its numerical value 3.
'    Set oDelFolder = oNsOutlook.GetDefaultFolder(3)
'    'set the items collection:
'    Set oDelItems = oDelFolder.Items
'
'    'determine number of items in the collection:
'    c = oDelItems.Count
'    'start deleting from the last item:
'    For n = c To 1 Step -1
'        oDelItems(n).Delete
'    Next n
'
    '----------------------------
    
    'set reference to the default Contact Items folder:
    'The numerical value of olFolderContacts is 10. The following code has replaced the Outlook's built-in constant olFolderContacts by its numerical value 10.
    Set oCFolder = oNsOutlook.GetDefaultFolder(10)
'    Set olItems = oCFolder.Items.Restrict("[MessageClass]='IPM.Contact'")
    
    'Find contact to update, if not found add a new contact item
    
    
    'post each row's data on a separate contact item form:
    For i = firstRowToProcess To lLastRow
    'restrict info: https://msdn.microsoft.com/en-us/vba/outlook-vba/articles/items-restrict-method-outlook
    'folder items info: https://msdn.microsoft.com/en-us/vba/outlook-vba/articles/folder-items-property-outlook
        Set olItems = oCFolder.Items.Restrict("[MessageClass]='IPM.Contact' And [Email1Address] = '" & Sheets(sheetName).Cells(i, Sheets("References").Range("email").Value) & "'")
        
        itemsFound = 0
        For Each olContactItem In olItems
            
            Application.StatusBar = "Updating Outlook contact " + olContactItem.FullName & ", " & Sheets(sheetName).Cells(i, Sheets("References").Range("pnr").Value)
            'matching contact found in Outlook and Excel
			'web pictures should be stored in a local folder
            fullFilePath = Replace(Sheets(sheetName).Cells(i, Sheets("References").Range("pictureurl").Value), "http://someimageurl", "C:\Users\username\Documents\Pictures\profilephotos\")
            If FileExists(fullFilePath) Then
                olContactItem.AddPicture (fullFilePath)
            Else
                'MsgBox ("Missing picture: " + fullFilePath + ", for member: " + olContactItem.firstName + " " + olContactItem.lastname)
                Debug.Print ("Missing picture: " & fullFilePath & ", for member: " & olContactItem.firstName & " " & olContactItem.lastName)
            End If
            If updateExistingContacts = True Then
                With olContactItem
                    'update existing contact fields https://msdn.microsoft.com/en-us/library/microsoft.office.interop.outlook._contactitem_properties.aspx
                    .firstName = Sheets(sheetName).Cells(i, Sheets("References").Range("first_name").Value)
                    .lastName = Sheets(sheetName).Cells(i, Sheets("References").Range("last_name").Value)
                    If (Sheets(sheetName).Cells(i, Sheets("References").Range("birthdate").Value) <> "") Then
                        .Birthday = DateValue(Sheets(sheetName).Cells(i, Sheets("References").Range("birthdate").Value))
                    End If
                    .BusinessAddressStreet = "BusinessStreet 100"
                    .BusinessAddressCity = "BusinessCity"
                    .BusinessAddressCountry = "BusinessCountry"
                    .BusinessAddressPostalCode = "BusinessPostal"
                    .BusinessHomePage = "http://www.company.com"
                    'do not remove or duplicate existing categories, set some desired category when not yet set
                    If (InStr(.Categories, "Business") = 0) Then
                        .Categories = .Categories & ",Business"
                    End If
                    .CompanyName = "Company"
                    .Email1DisplayName = Sheets(sheetName).Cells(i, Sheets("References").Range("email").Value)
                    .FullName = Sheets(sheetName).Cells(i, Sheets("References").Range("first_name").Value) & " " & Sheets(sheetName).Cells(i, Sheets("References").Range("last_name").Value)
                    .FileAs = Sheets(sheetName).Cells(i, Sheets("References").Range("first_name").Value) & " " & Sheets(sheetName).Cells(i, Sheets("References").Range("last_name").Value)
                    '.gender = Sheets(sheetName).Cells(i, Sheets("References").Range("gender").Value)
'                    If (Sheets(sheetName).Cells(i, Sheets("References").Range("gender").Value) = "M") Then
'                        .gender = Microsoft.Office.Interop.Outlook.OlGender.olMale
'                    ElseIf (Sheets(sheetName).Cells(i, Sheets("References").Range("gender").Value) = "F") Then
'                        .gender = Microsoft.Office.Interop.Outlook.OlGender.olFemale
'                    Else
'                        .gender = Microsoft.Office.Interop.Outlook.OlGender.olUnspecified
'                    End If
                    .HomeAddressCity = Sheets(sheetName).Cells(i, Sheets("References").Range("city").Value)
                    .HomeAddressCountry = "DefaultCountry"
                    .HomeAddressPostalCode = Sheets(sheetName).Cells(i, Sheets("References").Range("postcode").Value)
                    .HomeAddressStreet = Sheets(sheetName).Cells(i, Sheets("References").Range("street").Value) & " " & Sheets(sheetName).Cells(i, Sheets("References").Range("street_number").Value)
                    .JobTitle = Sheets(sheetName).Cells(i, Sheets("References").Range("current_function").Value)
                    '.Language = Sheets(sheetName).Cells(i, Sheets("References").Range("speaking_language_info_list").Value)
                    .MobileTelephoneNumber = Sheets(sheetName).Cells(i, Sheets("References").Range("mobile").Value)
                    .BusinessTelephoneNumber = Sheets(sheetName).Cells(i, Sheets("References").Range("phone").Value)
                    .BusinessFaxNumber = Sheets(sheetName).Cells(i, Sheets("References").Range("fax").Value)
                    .Department = Sheets(sheetName).Cells(i, Sheets("References").Range("division").Value)
                    .ManagerName = Sheets(sheetName).Cells(i, Sheets("References").Range("manager").Value)
                    .WebPage = "http://www.company.com"
                    If (InStr(.body, "Staff number: ") = 0) Then
                        .body = "Staff number: " & Sheets(sheetName).Cells(i, Sheets("References").Range("pnr").Value) & vbCrLf
                        .body = .body & "Recruitment date: " & Sheets(sheetName).Cells(i, Sheets("References").Range("recruitment_date").Value) & vbCrLf
                        .body = .body & "Education: " & Sheets(sheetName).Cells(i, Sheets("References").Range("educations").Value) & vbCrLf
                        .body = .body & "Languages: " & Sheets(sheetName).Cells(i, Sheets("References").Range("speaking_language_info_list").Value) & vbCrLf
                        .body = .body & "Specialty skills: " & Sheets(sheetName).Cells(i, Sheets("References").Range("specialty_skills").Value) & vbCrLf
'                    Else
' keeps original body note, but duplicates all data if run mulitple times
'                        originalBody = .body
'                        .body = "Staff number: " & Sheets(sheetName).Cells(i, Sheets("References").Range("pnr").Value) & vbCrLf
'                        .body = .body & "Recruitment date: " & Sheets(sheetName).Cells(i, Sheets("References").Range("recruitment_date").Value) & vbCrLf
'                        .body = .body & "Education: " & Sheets(sheetName).Cells(i, Sheets("References").Range("educations").Value) & vbCrLf
'                        .body = .body & "Languages: " & Sheets(sheetName).Cells(i, Sheets("References").Range("speaking_language_info_list").Value) & vbCrLf
'                        .body = .body & "Specialty skills: " & Sheets(sheetName).Cells(i, Sheets("References").Range("specialty_skills").Value) & vbCrLf
'                        .body = .body & vbCrLf & originalBody
                    End If
                End With
                                        
            End If
            Sheets(sheetName).Cells(i, Sheets("References").Range("processed").Value).Value = "OK"
            olContactItem.Save
            itemsFound = itemsFound + 1
        Next
        
        If itemsFound = 0 Then
            Application.StatusBar = "Adding Outlook contact " & Sheets(sheetName).Cells(i, Sheets("References").Range("first_name").Value) & " " & Sheets(sheetName).Cells(i, Sheets("References").Range("last_name").Value) & ", " & Sheets(sheetName).Cells(i, Sheets("References").Range("pnr").Value)
            'Using the Items.Add Method to create a new Outlook contact item in the default Contacts folder.
            Set oCItem = oCFolder.Items.Add
            'display the new contact item form:
            'oCItem.Display
            'set properties of the new contact item:
            With oCItem
                    'update existing contact fields https://msdn.microsoft.com/en-us/library/microsoft.office.interop.outlook._contactitem_properties.aspx
                    .firstName = Sheets(sheetName).Cells(i, Sheets("References").Range("first_name").Value)
                    .lastName = Sheets(sheetName).Cells(i, Sheets("References").Range("last_name").Value)
                    If (Sheets(sheetName).Cells(i, Sheets("References").Range("birthdate").Value) <> "") Then
                        .Birthday = DateValue(Sheets(sheetName).Cells(i, Sheets("References").Range("birthdate").Value))
                    End If
                    .BusinessAddressStreet = "BusinessStreet 100"
                    .BusinessAddressCity = "BusinessCity"
                    .BusinessAddressCountry = "BusinessCountry"
                    .BusinessAddressPostalCode = "BusinessPostal"
                    .BusinessHomePage = "http://www.company.com"
                    'do not remove or duplicate existing categories, set some desired category when not yet set
                    If (InStr(.Categories, "Business") = 0) Then
                        .Categories = .Categories & ",Business"
                    End If
                    .CompanyName = "Company"
                    .Email1DisplayName = Sheets(sheetName).Cells(i, Sheets("References").Range("email").Value)
                    .FullName = Sheets(sheetName).Cells(i, Sheets("References").Range("first_name").Value) & " " & Sheets(sheetName).Cells(i, Sheets("References").Range("last_name").Value)
                    .FileAs = Sheets(sheetName).Cells(i, Sheets("References").Range("first_name").Value) & " " & Sheets(sheetName).Cells(i, Sheets("References").Range("last_name").Value)
                    '.gender = Sheets(sheetName).Cells(i, Sheets("References").Range("gender").Value)
'                    If (Sheets(sheetName).Cells(i, Sheets("References").Range("gender").Value) = "M") Then
'                        .gender = Microsoft.Office.Interop.Outlook.OlGender.olMale
'                    ElseIf (Sheets(sheetName).Cells(i, Sheets("References").Range("gender").Value) = "F") Then
'                        .gender = Microsoft.Office.Interop.Outlook.OlGender.olFemale
'                    Else
'                        .gender = Microsoft.Office.Interop.Outlook.OlGender.olUnspecified
'                    End If
                    .HomeAddressCity = Sheets(sheetName).Cells(i, Sheets("References").Range("city").Value)
                    .HomeAddressCountry = "DefaultCountry"
                    .HomeAddressPostalCode = Sheets(sheetName).Cells(i, Sheets("References").Range("postcode").Value)
                    .HomeAddressStreet = Sheets(sheetName).Cells(i, Sheets("References").Range("street").Value) & " " & Sheets(sheetName).Cells(i, Sheets("References").Range("street_number").Value)
                    .JobTitle = Sheets(sheetName).Cells(i, Sheets("References").Range("current_function").Value)
                    '.Language = Sheets(sheetName).Cells(i, Sheets("References").Range("speaking_language_info_list").Value)
                    .MobileTelephoneNumber = Sheets(sheetName).Cells(i, Sheets("References").Range("mobile").Value)
                    .BusinessTelephoneNumber = Sheets(sheetName).Cells(i, Sheets("References").Range("phone").Value)
                    .BusinessFaxNumber = Sheets(sheetName).Cells(i, Sheets("References").Range("fax").Value)
                    .Department = Sheets(sheetName).Cells(i, Sheets("References").Range("division").Value)
                    .ManagerName = Sheets(sheetName).Cells(i, Sheets("References").Range("manager").Value)
                    .WebPage = "http://www.company.com"
                    If (InStr(.body, "Staff number: ") = 0) Then
                        .body = "Staff number: " & Sheets(sheetName).Cells(i, Sheets("References").Range("pnr").Value) & vbCrLf
                        .body = .body & "Recruitment date: " & Sheets(sheetName).Cells(i, Sheets("References").Range("recruitment_date").Value) & vbCrLf
                        .body = .body & "Education: " & Sheets(sheetName).Cells(i, Sheets("References").Range("educations").Value) & vbCrLf
                        .body = .body & "Languages: " & Sheets(sheetName).Cells(i, Sheets("References").Range("speaking_language_info_list").Value) & vbCrLf
                        .body = .body & "Specialty skills: " & Sheets(sheetName).Cells(i, Sheets("References").Range("specialty_skills").Value) & vbCrLf
                    End If
            End With
                
                'mark as done
                Sheets(sheetName).Cells(i, Sheets("References").Range("processed").Value).Value = "OK"
            fullFilePath = Replace(Sheets(sheetName).Cells(i, Sheets("References").Range("pictureurl").Value), "http://someimageurl", "C:\Users\username\Documents\Pictures\profilephotos\")
            If FileExists(fullFilePath) Then
                oCItem.AddPicture (fullFilePath)
            Else
                'MsgBox ("Missing picture: " + fullFilePath + ", for member: " + oCItem.firstName + " " + oCItem.lastname)
                Debug.Print ("Missing picture: " & fullFilePath + ", for member: " & oCItem.firstName & " " & oCItem.lastName)
            End If
            'close the new contact item form after saving:
            'The numerical value of olSave is 0. The following code has replaced the Outlook's built-in constant olSave by its numerical value 0.
            oCItem.Close 0
        End If
    Next i
    
    'quit the Oulook application:
    oApplOutlook.Quit
    
    Application.StatusBar = "Outlook " & lLastRow & " contacts exported"
    Application.ScreenUpdating = True
    
    'clear the variables:
    Set oApplOutlook = Nothing
    Set oNsOutlook = Nothing
    Set oCFolder = Nothing
    Set oDelFolder = Nothing
    Set oCItem = Nothing
    Set oDelItems = Nothing
    Set olContactItem = Nothing
    Set olItems = Nothing
    
    MsgBox "Successfully Exported Worksheet Data to the Default Outlook Contacts Folder."
    
     

End Sub

Function FileExists(fullFileName As String) As Boolean
    FileExists = VBA.Len(VBA.Dir(fullFileName)) > 0
End Function

Wednesday, February 21, 2018

If This Than That – Cloud service orchestration

IFTTT and other (Microsoft Flow, Zapier, Integromat) easily enable anyone to combine many cloud sIFTTTervices for task automation.

IFTTT is free and integrates many public cloud services, but it might seem limited in the combinations that can be created with it. Nevertheless I was surprised to see some nice examples that allow smart integration.

Control lights with planning:

I wanted to control my lights around the house, using a easy to manage planning (could be used to control central heating too). By combining the Google Calendar services and eWeLink IoT services, this was very easy and cheap, since only a Sonoff wifi relay had to be bought.

Within Google Calendar, I created a new calendar ‘Light-control’ with daily repeating events every evening to turn on the lights. Giving it a nice yellow color makes it very easy to get a clear overview.

Within IFTTT add a new applet with ‘if’ trigger Google Calendar ‘Any event starts’. The ‘then’ trigger can be set to eWeLink to switch on your Sonoff channel. Similar, another IFTTT applet can be created triggered on ‘Any event ends’ to switch off you Sonoff channel via the eWeLink Smart Home service.

By just updating your calendar events you can now very easily manage your IoT device planning. You can even ‘invite’ your lights to participate in a ‘meeting'. Just enable the Google Calendar option ‘Auto accept invites’ and put your calendar id (eg 123456789abcdefg@group.calendar.google.com) as a guest for your meeting and the light will switch on and off for your planned event.

Complex combinations

Sometime the one-on-one link that can be used for the service orchestration within IFTTT can be too limited. To enable complex combinations, apilio.io or switchur can be used.

As an example, using apilio.io, I wanted to be warned if frost would be expected tomorrow, to make sure I would protect my car windshield in time. But I want to get warned when arriving at home in the evening, to make sure I get notified while still in my car, while by default the Weather Underground service would provide the Weather forecast of tomorrow, early in the mornings.

First create you apilio.io account and register your IFTTT WebHooks settings.

Next, within apilio.io, I create 3 boolean variables:

  1. arriving_home
  2. evening
  3. frost_tomorrow

For each of these boolean variables, URL’s will be provided by apilio to set the value of the boolean to true or false using a unique webservice url.

Next, within IFTTT I created several applets:

1. IFTTT Location service:

  • applet if ‘You enter an areathen call the webhook url to set to ‘true’ the ‘arriving_home’ boolean
  • applet if ‘You exit an areathen call the webhook url to set to ‘false’ the ‘arriving_home’ booelan

2. IFTTT Date Time service:

  • applet if 17:00 (5pm) then call the webhook url to set to ‘true’ the ‘evening’ boolean
  • applet if 00:00 (0am) then call the webhook url to set to ‘false’ the ‘evening’ boolean

3. IFTTT Weather Underground service:

  • applet if ‘Tomorrow’s low drops below’ 4°C then call the webhook url to set to ‘true’ the ‘frost_tomorrow’ boolean
  • applet if ‘Tomorrow’s forecast calls for’ snow then call the webhook url to set to ‘true’ the ‘frost_tomorrow’ boolean
  • Since no trigger is available to set the boolean value ‘frost_tomorrow’ back on false, we will include in the apilio condition this value needs to be ‘changed’ at least within the last 24h. Weather Underground will typically provide the next day forecast at 7am.

4. IFTTT Webhook service (callback):

  • This webhook applet will be called by apilio to trigger a desired action when all conditions are met. The name of the applet is important, as it will need to be registered within apilio in order to call the right applet. If the applet is called, then a desired action can be triggered, eg showing a notification on your mobile.

Again within apilio.io, I created 3 conditions:

  1. at_home_condition –> linked to value of variable ‘arriving_home’
  2. evening_condition –> linked to value of variable ‘evening’
  3. frost_tomorrow_condition –> linked to value of variable ‘frost_tomorrow’ including the timestamp restriction the value has to be modified within 72000seconds.

Now, within apilio.io, a logic block can be created, linked to the 3 conditions created above. When all conditions are met, the IFTTT webhook can be called by apilio. The name of the IFTTT webhook callback applet created before needs to be provided. Enable the ‘Automatic evaluation’ to evaluate the conditions defined in the logic block whenever any of the condition values changes.

To test the complete setup, the different apilio URL’s to set the boolean values can be called manually to see if the resulting IFTTT webhook appled is called as soon as all conditions are met.

In this example, only boolean variables have been used, which makes the link between a variable and the condition within apilio very straightforward. But whenever needed string or numeric variables can be defined as well. The conditions related to these variables can get more complex evaluations, such as containing some values or smaller, equal, etc.

Feel free to comment or add extra ideas of interesting combinations that would be possible.

Monday, April 11, 2016

Outlook default reminder for sent mails

Since most of the time, I need to follow up my mails send out to make sure the expected actions are taken, I do add a reminder on my send email. So I can verify in a couple of days if I did get a reaction or the expected action has been taken in the meantime.

In order to automate this, I added the outlook macro shown below. It’s based on the nice example provided by Diane Poremsky. I just improved it a bit to set the default reminder at 10am in 5 days (moving some days forward whenever the 5 days would end in the weekend). After sending an email, a little popup will show up indicating the reminder would be created for within 5 business days. The number of days can quickly be changed or the reminder can fully be discared using the ‘Cancel’ on the pop-up. After some days of usage, I’m very satisfied with the result. The popup will appear after sending the message, so the email will always be sent and won’t be blocked if the pop-up wouldn’t be noticed.

OutlookReminderPopup

Of course this is only useful when you often need a follow-up on your sent mails…

'Instructions:    
'myT 04/2016, http://myTselection.blogspot.com
  'Default reminder for sent mails: add a default reminder for every sent mail, default 5 working days with popup to cancel or confirm (and set number of days)
  'Instructions:
  'Open Outlook and press [ALT+F11] to open the VBS developer editor
  'Navigate to 'Project 1 VbaProject.OTM' > Microsoft Outlook Objects > ThisOutlookSession
  'Copy and Paste the macro below and close the VBS editor
  'Make sure the line 'Private WithEvents olSentItems as Items' is saved at the top of the file
  Private WithEvents olSentItems As Items
  Attribute olSentItems.VB_VarHelpID = -1
  Private Declare PtrSafe Function ShellExecute _
  Lib "shell32.dll" Alias "ShellExecuteA" ( _
  ByVal hWnd As Long, _
  ByVal Operation As String, _
  ByVal Filename As String, _
  Optional ByVal Parameters As String, _
  Optional ByVal Directory As String, _
  Optional ByVal WindowStyle As Long = vbMinimizedFocus _
  ) As Long
  'Original source: http://www.slipstick.com/developer/code-samples/set-flag-follow-up-using-vba/
  Private Sub Application_Startup()
  'MsgBox ("test startup")
  Dim objNS As NameSpace
  Set objNS = Application.Session
  ' instantiate objects declared WithEvents
  Set olSentItems = objNS.GetDefaultFolder(olFolderSentMail).Items
  Set objNS = Nothing
  End Sub
  Private Sub olSentItems_ItemAdd(ByVal Item As Object)
  'On Error Resume Next
  Dim prompt As String
  Dim dtmTemp As Date
  Dim businessDays As String
  Dim reminderTime As String
  Dim dueDateDays As Integer
  'MsgBox ("test item sent")
  If TypeName(Item) = "MailItem" Then
          businessDays = 5
      dueDateDays = 14
      reminderTime = "10:00:00 AM"
            'Reminder in 5 days, 10 AM
        dtmTemp = DateValue(Now + businessDays) & " " & TimeValue(reminderTime)
        'skip days if reminder would result in weekend
        Do While IsWeekend(dtmTemp)
            dtmTemp = dtmTemp + 1
        Loop
                    'InputBox(prompt[, title] [, default] )
        businessDays = InputBox("Do you want to add a reminder for the email sent? " & vbCrLf & vbCrLf _
        & " Subject: " & Item.Subject & vbCrLf _
        & " To: " & Item.To & vbCrLf & vbCrLf & vbCrLf _
        & "Set # business days for the reminder" & vbCrLf _
        & " Default " & businessDays & " business days: " & WeekdayName(Weekday(dtmTemp), True, vbSunday) & " " & dtmTemp, _
        "Add a reminder for the email sent?", businessDays)
              'Exit sub if user press Cancel button or does not enter any text in the Input field.
        If businessDays = vbNullString Then Exit Sub
              dtmTemp = DateValue(Now + CInt(businessDays)) & " " & TimeValue(reminderTime)
        'skip days if reminder would result in weekend
        Do While IsWeekend(dtmTemp)
            dtmTemp = dtmTemp + 1
        Loop
                           With Item
            .MarkAsTask olMarkThisWeek
              ' sets a due date in 14 days
            .TaskDueDate = Now + dueDateDays
            .ReminderSet = True
            .reminderTime = dtmTemp
            .Save
        End With
    End If
  End Sub

Update 27/06/2016: added check on item type to make sure no error occur when responding to an meeting request.

Thursday, April 23, 2015

Outlook warn when forgetting attachment

When an outlook message indicates an attachment is added, but the attachment is missing, the Outlook 2010 VBA macro below can warn you about this with a popup. This option became a standard option in Outlook 2013, as indicated on this site.

This version of the macro has been extended compared to many similar macro’s you could find online:

  • It allows to configure multiple words to scan for, currently scanning for attach, bijlage, bijgevoegd (see inline VBA comments)
  • It will only scan the new message body and the header. It will ignore the reply/forward message body content.
  • It has been improved for html/rich text/plain text emails formatting
  • It allows you to configure if attachments are part of your signature
  • Non-mail outlook item types will not result in VBA errors (eg. when responding a meeting request)

All feedback is welcome, since only tested on a English version of Outlook 2010.

Installation instructions:

  • Open Outlook and press [ALT+F11] to open the VBS developer editor
  • Navigate to 'Project 1 VbaProject.OTM' > Microsoft Outlook Objects > ThisOutlookSession
  • Copy and Paste the macro below and close the VBS editor or import the ‘ThisOutlookSession.cls’ file

Source Office VBA macro script:

'myT 04/2015, http://myTselection.blogspot.com    
'Instructions:
'Open Outlook and press [ALT+F11] to open the VBS developer editor
'Navigate to 'Project 1 VbaProject.OTM' > Microsoft Outlook Objects > ThisOutlookSession
'Copy and Paste the macro below and close the VBS editor
Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
Dim m As Variant, t As Variant
Dim strBody As String
Dim intIn As Long
Dim intAttachCount As Integer, intStandardAttachCount As Integer, limitBody As Integer
On Error GoTo handleError
'Edit the following line if you have a signature on your email that includes images or other files. Make intStandardAttachCount equal the number of files in your signature.
intStandardAttachCount = 0
'If CheckProperty(Item, "HTMLBody") Then
'    strBody = LCase(Item.HTMLBody) & " " & LCase(Item.Subject)
'Else
'    strBody = LCase(Item.Body) & " " & LCase(Item.Subject)
'End If
On Error GoTo NoHtml
strBody = LCase(Item.HTMLBody) & " " & LCase(Item.Subject)
'Show Debug via View > Immediate Window (Ctrl+G)
'Debug.Print strBody
On Error GoTo handleError
'detect line break where previous messages (reply/forward) are starting, only scan the newly create message ignoring forwarded/replied text
'HTML original message splitter
limitBody = InStr(1, strBody, "<div style='border:none;border-top:solid #b5c4df 1.0pt;padding:3.0pt 0cm 0cm 0cm'>")
'RichText has HTMLBody but no border separator
If limitBody = 0 Then GoTo RichText
GoTo commonHandling
RichText:
    On Error GoTo handleError
    'could test on availability of 'text/rtf format' in body to make sure this is rich text case
    strBody = LCase(Item.Body) & " " & LCase(Item.Subject)
    'rich text original message splitter
    limitBody = InStr(1, strBody, "_____________________________________________")
GoTo commonHandling
NoHtml:
    On Error GoTo handleError
    strBody = LCase(Item.Body) & " " & LCase(Item.Subject)
    'detect line break where previous messages (reply/forward) are starting, only scan the newly create message ignoring forwarded/replied text
    'Plain text message splitter
    limitBody = InStr(1, strBody, "-----")
GoTo commonHandling
commonHandling:
    On Error GoTo handleError
    'Show Debug via View > Immediate Window (Ctrl+G)
    'Debug.Print strBody
   
    If limitBody = 0 Then limitBody = Len(strBody)
   
   
    intIn = InStr(1, Left(strBody, limitBody), "attach")
    intIn = intIn + InStr(1, Left(strBody, limitBody), "bijlage")
    intIn = intIn + InStr(1, Left(strBody, limitBody), "bijgevoegd")
    'Copy previous line to add extra keywords
   
    intAttachCount = Item.Attachments.Count
   
    If (intIn <> 0 And intAttachCount = intStandardAttachCount) Then
       
        m = MsgBox("It appears that you mean to send an attachment, " & vbCrLf & "but there is no attachment to this message." & vbCrLf & vbCrLf & "Do you still want to send without attachments?", vbQuestion + vbYesNo + vbMsgBoxSetForeground, "Missing attachment")
   
        If m = vbNo Then
            Cancel = True
        End If
    End If
handleError:
    If (Err.Number <> 0) Then
        t = MsgBox("Outlook Attachment Reminder Error " & Err.Description & ", " & Err.Number & ", " & Err.Source, vbExclamation, "Outlook Attachment Reminder Error")
    End If
End Sub


Download the macro and instructions in a TXT file.

Wednesday, December 18, 2013

iTop running on Windows portable PHP/MySQL MoWeS

Based on my previous topic informing about the nice functionalities of MoWeS to get easily and quickly a PHP/MySQL environment, I did set up an iTop environment in order to discover and play with the CMDB/ITIL ticketing service desk tool.

While doing so, I also discovered the MoWeS Mixer is not available any longer. Apparently the company Chsoftware behind this tools has stopped in 2012. But the MoWeS tool still works very well on Windows 7 x64 and new packages can easily be added by updating the mowes.ini and packages.ini files manually.

In order to get iTop running, some other parameters had to be updated as well: extra memory allocation is to be allowed in php.ini by changing the memory_limit from 32M to 64M. The php_soap.dll extension needs to be loaded as well by uncommenting it in the php.ini file. For mysql, the allowed packets needed to be extended by adding a parameter max_allowed_packet=500M within the [mysqld] section of the my.ini file.

I’ve created an archive containing a clean MoWeS environment with clean iTop. The iTop still needs to be configured using the web wizard upon first connection to the iTop site (localhost/itop) (mysql username: root, password: <empty>. I’ve also a MoWeS environment with base demo iTop installed (itop username: admin, password: itop).

Sunday, December 8, 2013

vCard contact export from Excel contact list

Recently I needed a way to easily convert a list with contact information into a vCard file, respecting the vCard syntax, in order to import this vCard contact information into a phone.

After some quick Google lookup I ended with this nice Excel created and shared by Savas Geivanidis.

After entering all the contact information into the sheet as instructed, the export macro started executing it’s work and I ended with a vCard file as I wanted. But the process took very long (more than 4 minutes), even if my contact list only contained 100 contacts.

Since Savas was so kind to keep his VBS macro unprotected, I analyzed it and optimized it. The main performance issues I detected was the multiple loops and the cell deletions used in the code. A loop was set up to run over the contact data, and copy all data it into a new sheet. Next a loop was used to run through the data and delete all cell containing the value ‘no data’. Next the new sheet was saved into a text .vcf file.

After rewriting the VBS macro I ended up with one loop, running through the data and saving the information immediately into a text file. The same list of 100 contacts now takes less than 1sec to export instead of more than 4 minutes. Some tests with 1000 contacts were positive as it took only 4sec or less to export. I ended up cleaning up the full sheet and creating a template of it to allow easy reuse. Feel free to use this version 1.0 of vCard Exporter for any purpose.

The optimized source code is shown below for illustration:

Sub Create_vCard() 

'

' This Macro creates a vCard from an existing phonebook Excel list

'__________________________________________________________________

' Based on DesktopContacts v0.8 by Savas Geivanidis (savas@mycosmos.gr) egnatia.ee.auth.gr/~aki/dc/DesktopContacts0.8.xls

' Major performance improvements by myT in vCardExporter v1.0

'___________________________________________________________________

   
    Application.ScreenUpdating = False

    ' turns off screen updating

    Application.DisplayStatusBar = True

    ' makes sure that the statusbar is visible

   
    'detect number of data contacts provided

    'mainsheet = ActiveSheet.Name

    mainsheet = "PhoneBook"

    Range("A30000").Select

    Selection.End(xlUp).Select

    nod = ActiveCell.Row

    Range("B30000").Select

    Selection.End(xlUp).Select

    nod1 = ActiveCell.Row

    If nod1 > nod Then

        nod = nod1

    End If

   
    'Check if data is provided

    If nod <= 2 Then

        popup = MsgBox("No contact data could be found. Fill in the contact data in the 'PhoneBook' sheet and provide at least a first or last name for each contact." & vbLf & "See the 'Information' sheet and http://myTselection.blogpsot.com for more information", vbExclamation + vbOKOnly + vbMsgBoxSetForeground, "vCard Exporter: No data found")

        Application.ScreenUpdating = True

        Exit Sub

    End If

   
    'request target filename

    vcardname = Application.GetSaveAsFilename("", "vCard Files (*.vcf), *.vcf", , "Please select the name of the vCard to export")

    If vcardname = False Then

        Application.ScreenUpdating = True

        Exit Sub

    End If

    start_time = Now()

    Application.StatusBar = "Preparing VCARD data"

   
   
    Set vcardFileSystemObject = CreateObject("Scripting.FileSystemObject")

    Set vcardFile = vcardFileSystemObject.CreateTextFile(vcardname, True)

   
   
    'copy formula for VCARD syntax to all rows with contact data

    Range(Cells(1, 61), Cells(1, 101)).Copy

    Range(Cells(3, 61), Cells(nod, 101)).PasteSpecial Paste:=xlPasteFormulas

    Application.CutCopyMode = False

    Range("A3").Select

   
    Application.StatusBar = "Processing contact data..."

   
    vcardFile.writeline ("")

    For iRow = 3 To nod

        For iColumn = 61 To 101

            currentValue = Worksheets(mainsheet).Cells(iRow, iColumn).Value

            Application.StatusBar = "Processing contact data " & Round(((iRow - 2) / (nod - 2)) * 100) & "%" '&" on row " & iRow & ", column " & iColumn & ", value: " & currentValue

            If (currentValue <> "no data") Then

                vcardFile.writeline (currentValue)

            End If

            If currentValue = "END:VCARD" Then

                vcardFile.writeline ("")

            End If

        Next iColumn

    Next iRow

    vcardFile.Close

    Application.StatusBar = "All " & nod - 2 & " contact data processed"

   
    Worksheets(mainsheet).Range(Cells(2, 61), Cells(nod, 101)).ClearContents

    Worksheets(mainsheet).Range("A3").Select

    end_time = Now()

    'DateDiff("s", start_time, end_time)

    Application.StatusBar = "vCard export in " & PrintHrMinSec(DateDiff("s", start_time, end_time)) & "sec done into file: " & vcardname

    Application.ScreenUpdating = True

   
    If (nod - 2 = 1) Then

        popup = MsgBox(nod - 2 & " contact is exported to:" & vbLf & "'" & vcardname & "'" & vbLf & vbLf & "Please send this file to your phone and run it in order to add this contact into it." & vbLf & vbLf & "Original development 'Desktop Contacts v0.8' by Savas Geivanidis (aki@egnatia.ee.auth.gr)" & vbLf & vbLf & "Major layout and performance improvements myT in 'vCard Exporter v1.0' - http://myTselection.blogpsot.com", vbInformation + vbOKOnly + vbMsgBoxSetForeground, "vCard Exporter: data exported")

    Else

        popup = MsgBox(nod - 2 & " contacts were exported to:" & vbLf & "'" & vcardname & "'" & vbLf & vbLf & "Please send this file to your phone and run it in order to add these contacts into it." & vbLf & vbLf & "Original development 'Desktop Contacts v0.8' by Savas Geivanidis (aki@egnatia.ee.auth.gr)" & vbLf & vbLf & "Major layout and performance improvements myT in 'vCard Exporter v1.0' - http://myTselection.blogpsot.com"", vbInformation + vbOKOnly + vbMsgBoxSetForeground, "vCard Exporter: data exported")

    End If

    Application.DisplayStatusBar = True

End Sub

'***********************

'* This function calculates hours, minutes

'* and seconds based on how many seconds

'* are passed in and returns a nice format

Public Function PrintHrMinSec(elap)

  Dim hr

  Dim min

  Dim sec

  Dim remainder

 
  elap = Int(elap) 'Just use the INTeger portion of the variable

 
  'Using "\" returns just the integer portion of a quotient

  hr = elap \ 3600 '1 hour = 3600 seconds

  remainder = elap - hr * 3600

  min = remainder \ 60

  remainder = remainder - min * 60

  sec = remainder

 
  'Prepend leading zeroes if necessary

  If Len(sec) = 1 Then sec = "0" & sec

  If Len(min) = 1 Then min = "0" & min

 
  'Only show the Hours field if it's non-zero

  If hr = 0 Then

     PrintHrMinSec = min & ":" & sec

  Else

     PrintHrMinSec = hr & ":" & min & ":" & sec

  End If

 
End Function

Sunday, August 18, 2013

Google Apps Script demo – Send SMS on new important mail in GMail

Google Drive allows you to easily create and edit Documents, Presentations, Spreadsheets, Forms and Drawings. But not everyone might be familiar with the Google App Script integration functionalities similar to the Visual Basic scripting integration within Microsoft Office macro’s.

Recently, I found this tutorial to link GMail to Google Calendar written by Romain Vialard.

Based on this tutorial, I made the custom script below in order to get a free SMS’s from Google on every new unread e-mail marked as ‘Important’ within GMail. Setting up this little script will give you a brief indication of the power and possibilities of the Google App Script integration.

  1. In Google Calendar, register your mobile phone within the ‘Settings’ > ‘Mobile Setup’, to enable SMS notifications. Sending SMS’s from within Google is free of charges, but it might be limited to 50 messages per day.
  2. In Gmail, create a new label named 'NbSMS' (Notified by SMS). Once a new mail has been notified by SMS, this label will be assigned to the mail in order to make sure the notification is send out only once and the mail will be ignored by the script once this label is assigned.
  3. In Google Drive, create a new Spreadsheet, give it any name.
  4. Choose the menu ‘Tools’ > ‘Script Editor’.
  5. Choose ‘Create script for: Blank Project’.
  6. Copy and paste the following script:
    function sendText() {
    Logger.log('Start of sendText script');
    var today = new Date();
    var nowHour = today.getHours();
    var startTime = 8;
    var endTime = 24;

    Logger.log('The SMS notification will only run between: ' + startTime + ' and ' + endTime + ', current hour: ' + nowHour);
    if (nowHour <= startTime || nowHour >= endTime) {
    Logger.log('Quite time, no SMS notification will be sent between: ' + startTime + ' and ' + endTime + ', current hour: ' + nowHour);
    } else {
    // var events = cal.getEvents(new Date(startDateAndTime), new Date(endDateAndTime));
    //based on https://developers.google.com/apps-script/articles/gmail_filter_sms
    var notifiedBySmsLabel = 'NbSMS';
    var unreadPriority = GmailApp.getPriorityInboxUnreadCount();
    var unreadsFound = 0;
    Logger.log("Number of unread emails in your Priority Inbox : " +
    GmailApp.getPriorityInboxUnreadCount());
    if (unreadPriority > 0) {
    var threads = GmailApp.getPriorityInboxThreads();
    //threads.refresh();
    var now = new Date().getTime();
    var alreadyNotified = false;
    for(i in threads){
    if (!threads[i].isUnread()) {
    alreadyNotified = true;
    if(unreadsFound >= unreadPriority) {
    break;
    } else {
    continue;
    }
    } else {
    ++unreadsFound;
    }
    var threadLabels = threads[i].getLabels();
    for(y in threadLabels) {
    if(threadLabels[y].getName() == notifiedBySmsLabel) {
    alreadyNotified = true;
    break;
    }
    }
    if (!alreadyNotified) {
    var smsText = 'Mail: '+threads[i].getFirstMessageSubject() + ', from: ' + threads[i].getMessages()[0].getFrom();
    smsText = smsText + ' ' + threads[i].getMessages()[0].getPlainBody();
    Logger.log('Event with SMS will be created with content: ' + smsText);
    var event = CalendarApp.createEvent(smsText,
    new Date(now+60000),
    new Date(now+60000));
    event.setDescription(smsText);
    event.addSmsReminder(0);
    var label = GmailApp.getUserLabelByName(notifiedBySmsLabel);
    label.addToThread(threads[i]);
    }
    }
    //threads.refresh();
    Logger.log('All important messages treated and label ' + notifiedBySmsLabel + ' applied.');
    }
    }
    }



  7. Choose the menu ‘Resources’ > ‘Current project’s triggers…’ and add a new trigger.


  8. Select the function ‘sendText()’ > Events: ‘Time-driven’ > ‘Minutes timer’ > ‘Every 5 minutes’, and save the trigger.


  9. Save the script.


  10. Click the Run ► icon. A pop-up opens asking you for your authorization to access the Gmail and Google Calendar services.


  11. Click the Authorize button.


  12. Click the Run ► icon again.


  13. Choose the menu ‘View’ > ‘Logs’ to see the log output.


  14. Debugging is possible using the bug icon. Set some breakpoints by clicking on the line number next to the script.


  15. After one minute, you should receive a text on your mobile device, containing the subject of the important unread emails within GMail.


  16. To see what other functionalities are available within GMail, Google Calendar en other Google services, see the Google App Script reference guide.


  17. Some other interesting tutorial to work with Google Calendar events is available in this blog post.



Update 09/04/2014: optimized the labeling to only apply the label to messages which were not yet labeled, instead of all messages in priority inbox.



Update 21/10/2015: Google no longer supports to get notified by SMS for a calendar item. So the approach above won’t work any longer (calendar item will be created, but no sms will be received).

Thursday, August 8, 2013

Svn file full history

If you’d need to search in the full history of a file stored in SVN, the script below can make an export of all changes ever applied into a file, starting for the first revision (full file) and adding each time an overview of all changes applied.

If you remember you ever applied some changes in a file, but removed it afterwards, this can help to search in the full history. Only tested on text based files.

For each revision, the revision number, author, timestamp and svn comments will be listed, followed by an overview of the removed lines, added lines, update lines etc. The initial revision will be a full extract of the original file.

Usage: save the SvnFileFullHistory.bat script in an SVN folder next to the file for which you’d need a full history extract. Drop the svn file onto the bat script to start the script and retrieve the full history of the dropped svn file. The full svn file history will be saved in a txt file in the same folder and with the same base name as the file to extract, but adding “-FullSvnHistory.txt” behind the file name. The extract can take a while, depending on the number of revisions and the size of the svn file. But while the extract is ongoing, the “…-FullSvnHistory.txt” can be read already, reloading it to get future updates.

A similar linux shell script has been created as well (not fully tested).

Based on information found on stackoverflow by user ladenedge.

Full script content:

@echo off   
TITLE SVN - Full file history
REM Original source: http://stackoverflow.com/questions/282802/how-can-i-view-all-historical-changes-to-a-file-in-svn and http://stackoverflow.com/questions/5622367/generate-history-of-changes-on-a-file-in-svn/5721533#5721533
echo Copy this bat script next to the checked out svn file on which to get full svn history. Drag and drop the svn file onto the bat script to start fetching the info (or a open command window and provide the name of the svn file as first parameter to the bat script execution)
if "%1%"=="" pause
set file=%1
set report=%file%-FullSvnHistory.txt
if [%file%] == [] (
  echo Usage: "%0 <file>"
  exit /b
)
echo Retrieving svn history of file, please wait...
echo The report will be saved in the file: %report%.
echo To stop the process press Ctrl+c.
rem first revision as full text
for /F "tokens=1 delims=-r " %%R in ('"svn log -q %file%"') do (
  svn log -r %%R %file% > %report%
  svn cat -r %%R %file% >> %report%
  goto :diffs
)
:diffs
rem remaining revisions as differences to previous revision
for /F "skip=2 tokens=1 delims=-r " %%R in ('"svn log -q %file%"') do (
  echo.
  svn log -r %%R %file% >> %report%
  svn diff -c %%R %file% >> %report%
)

Saturday, September 29, 2012

My Excel macro selection

Some easy to use Excel macro’s. All explained below are available in one Excel Macro Example.

All macro’s are combined in one example Excel sheet template to test the usage of it.

Password Generation

Function RndPassword(vLength)
'This function will generate a random strong password of variable
'length.
'This script is provided under the Creative Commons license located
'at http://creativecommons.org/licenses/by-nc/2.5/ . It may not
'be used for commercial purposes with out the expressed written consent
'of NateRice.com

For x = 1 To vLength
Randomize
vChar = Int(89 * Rnd) + 33
If vChar = 34 Then 'this is quote character, replace it with a single quote
vChar = 39
End If
RndPassword = RndPassword & Chr(vChar)
Next
End Function








An example usage of this Password generation function: I have a list with on each row a button to generate a password in the cell next to the button. Each button is linked to the same macro (for easy copy paste of the row). The cell to fill with the new password is automatically detected based on the cell in which the button is drawn. Before setting the new generated password, a warning is shown in a message box.









ExcelMacroPasswordGeenration









Sub Process_GenNewPassword()
Dim LRange As String
Dim RowOffset As Integer
Dim ColumnOffset As Integer
Dim newGenPassword As String
'Find cell that button resides in
LName = Application.Caller
Set bBox = ActiveSheet.Buttons(LName)
LRange = bBox.TopLeftCell.Address
RowOffset = 0 ' relative location of the row in which to work, same row used
FirstNameColumnOffset = -5 ' relative location of firstname column in row to show in warning message box
LastNameColumnOffset = -4 ' relative location of lastname column in row to show in warning message box
PasswordColumnOffset = 2 ' relative location of column in row where the generated password should be set
sResult = MsgBox("The password for user '" & Range(LRange).Offset(RowOffset, FirstNameColumnOffset).Value & " " & Range(LRange).Offset(RowOffset, LastNameColumnOffset).Value & "' will be replaced with a new random password!", vbExclamation + vbOKCancel, "New password generation")
If (sResult <> 1) Then
Exit Sub
End If
newGenPassword = RndPassword(10)
Range(LRange).Offset(RowOffset, PasswordColumnOffset).Value = newGenPassword
End Sub








Checkboxes









Checkbox LinkedCell









Whenever you need many checkboxes in your sheet, you'll probably need each checkbox to be linked to the cell it is residing on.




When copy-pasting rows or columns, the checkboxes will be copied as well, but they will still be linked to the same cell as the checkbox you started to copy-paste. The little macro shown below, will update each Checkbox on the active sheet and set it's linked cell to the cell on which the Checkbox is drawn.









Sub setCheckBoxLinkedCell()
'Loop through all Checkboxes in the active sheet
'Set for each Checkbox it's "LinkedCell" value to the cell on which the Checkbox is drawn
Application.ScreenUpdating = False
' turns off screen updating
Application.DisplayStatusBar = True
' makes sure that the statusbar is visible
Application.StatusBar = "Updating linked cells of all Checkboxes in this sheet."
For Each chk In ActiveSheet.Checkboxes
LRow = ActiveSheet.Checkboxes(chk.Name).TopLeftCell.Row
LColumn = ActiveSheet.Checkboxes(chk.Name).TopLeftCell.Column
cA1 = Application.ConvertFormula("R" & LRow & "C" & LColumn, xlR1C1, xlA1)

ActiveSheet.Shapes.Range(Array(chk.Name)).Select
With Selection
.Value = xlOff
.LinkedCell = cA1
.Display3DShading = False
End With
Next chk
Application.StatusBar = "Linked cells of all Checkboxes in this sheet are updated."
Application.ScreenUpdating = True
End Sub








Save date on Checkbox check









The macro below will set the date in the cell next to the Checkbox whenever the checkbox is checked. All checkboxes are linked to the same macro, for easy copy-pasting. The cell in which to save the date will be detected based on the checkbox location.









ExcelMacroCheckboxDate









Sub Process_CheckBox()
Dim cBox As CheckBox
Dim LRow As Integer
Dim LRange As String

LName = Application.Caller
Set cBox = ActiveSheet.Checkboxes(LName)

'Find address that checkbox resides in
LRange = cBox.TopLeftCell.Address
DateRowOffset = 0 ' row offset (relative to the checkbox location) in which the date should be set
DateColumnOffset = 1 ' column offset (relative to the checkbox location) in which the date should be set

'Change date if checkbox is checked
If cBox.Value > 0 Then
Range(LRange).Offset(DateRowOffset, DateColumnOffset).Value = Date

'Clear date if checkbox is unchecked
Else
Range(LRange).Offset(DateRowOffset, DateColumnOffset).Value = Null
End If
End Sub








Create Folder Structure









I copied my previously explained 'Create Folder Structure' in this Excel Macros Example. For all details, see my previous blog post. An import of an existing system folder structure is now added in there as well.









ExcelMacroCreateFolderStructure









Run macro upon opening a workbook




To run a macro whenever the workbook Excel sheet is opened, the Sub Workbook_Open in 'ThisWorkbook' can be used. This is needed if you want to link some keyboard keys to specific macro's.







Link keys to macro




To link a keyboard key to a specific macro action, the Application.OnKey "..." can be used in the auto startup macro. The keys must be unlinked before closing the workbook. I used this functionality in my Exam Point Counter workbook, described in this previous blog post. In 'ThisWorkbook':







'startup macro
Private Sub Workbook_Open()
Application.OnKey "t", "tKeyPressed"
Application.OnKey "e", "eKeyPressed"
Application.OnKey "s", "sKeyPressed"
Application.OnKey "t", "tKeyPressed"
End Sub
Private Sub Workbook_BeforeClose()
Application.OnKey "t"
Application.OnKey "e"
Application.OnKey "s"
Application.OnKey "t"
End Sub



In any module, for example KeyboardAction:







Sub tKeyPressed()
Application.DisplayStatusBar = True
Application.StatusBar = "t key linked to special action in KeyboardAction module"
End Sub
Sub eKeyPressed()
Application.DisplayStatusBar = True
Application.StatusBar = "e key linked to special action in KeyboardAction module"
End Sub
Sub sKeyPressed()
Application.DisplayStatusBar = True
Application.StatusBar = "s key linked to special action in KeyboardAction module"
End Sub








Search Lookup









The search lookup functionality has also been described in details in this previous blog post. The macro is included in this Excel Macro Example as well.









The formula for E9 below looks like:









 ExcelMacroSearchLookupFomula









ExcelMacroSearchLookup









Open Save









A button with linked macro to navigate to a folder is shown in the module 'OpenSave'.








A basic example of the resource exporter I showed in a previous post, is included as well. It will export the example data set into a text file, and while doing so, all special characters will be converted (eg &#233). For rows in the list of AlternativeEncoding, an alternative encoding for special characters will be used (eg \u00E9). To make the sheet readable, the special characters can be converted back into readable special characters. The conversion is based on a hex2ascii converter, unicode encoding, html encoding and decoding.









When you would reuse this code, please note, in order to support FileSystemObject, you’ll need to add reference to Microsoft scripting runtime in your Excel workbook VBA. In order to do so, open the Visual Basic environment in Excel (ALT+F11) > Menu ‘Tools’ > ‘Reference’ > Enable ‘Microsoft Scripting Runtime’. If this isn’t done in the workbook, the error ‘User defined type not defined’ will appear when writing an export file on ‘Dim fso As New FileSystemObject’.









ExcelMacroOpenSave









When the special characters are encoded using the macro, they will look like this:









ExcelMacroOpenSaveEncoded









PhoneBook vCard export



A sheet in which all phonebook data can be added (can be exported from any other application) is now available. Once all contact information is set, it can be exported into a vCard format which is supported by many address and contact management applications. More details can be found in this specific blog post.



image



All code is available in the Excel Macro Example.

Monday, August 27, 2012

My Android selection

I recently moved to Android. Starting with a cheap but excellent Archos A80s G9 Turbo 16GB TI OMAP4430 dual core 1,2GHz with 3G usb stick. It was one of the first tablets to get official ICS support and it has a very good XDA support for rooting and custom roms. Last week I replaced my old Samsung B7610 Pro Windows Mobile 6.5 phone for a Sony Xperia Sola MT27i Android 2.3.7 rooted and custom rom SSpeed. The ICS update should become available soon.

A list of my favorite applications I found very useful:

  • TeamViewer: free easy VNC with no firewall configuration
  • Google Reader: RSS reader
  • AirDroid: manage your Android device via browser in local network
  • Roboform: manage all your passwords securely and automated login/saving. Synchronized in cloud for full desktop synchronization and making sure you’ve your passwords everywhere in sync.
  • PhoneAlarm: never miss a new reminder/sms/mail/call by repeating the notification
  • IM+: connect all chat accounts at once (Google Talk, Facebook, MSN, Skype, Yahoo, etc)
  • TriCount: easy track and calculate group expenses
  • GoldenDict: offline dictionary compatible with the enormous Babylon dictionaries and custom Babylon dicts
  • myShopi: grocery list to remember what to buy in which shop, integrated list of shops and their opening hours, coupons and recipes
  • Smart Tools: use compass, gyro, accelerometer, flashlight, camera to measure etc
  • Opera mobile: browser
  • Business Calendar: many calendar look and feel options
  • Weather Service Pro: weather info and widget, still able to show cached info while offline (unlike many others)
  • Shazam Encore: record short music to get full info on artist, offline record possible to get full info later while online
  • TVGids 2.0: TV schedule overview compatible with Belgian tv
  • Mixologist: good looking bar and mix info
  • Knots3D: info on how to tie knots, with full usage info and 3D details
  • Car Locator: locate your car, automatically save car location when disconnection Bluetooth car headset
  • Sygic drive: offline GSP navigation, download maps
  • FolderSync: file manager and synchronization of all cloud storage service (Amazon S3, Box.net, dropbox, ftp, google docs, google drive, netdocuments, sftp, SkyDrive, SMB, SugarSync, Ubuntu One, WebDAV)
  • FileExpert: filemanager with integrated zip and rar archive support
  • AutomateIt: automate tasks, alternative for Tasker
  • Find My Phone: retrieve phone GPS location by sending special SMSs with password or make your phone ring on max volume level by sending specific sms (even when phone is muted and offline)
  • Ultra Keyboard: keyboard with many customization options and multi clipboard
  • Camera Zoom FX: camera app with special effects and optimized quality
  • Gallery Excluder: exclude some folder to be shown in Android default image gallery
  • OneNote: MS Office OneNote synchronized notes
  • Evernote: notes saved in cloud
  • Call Log Calendar: keep track of each call and SMSs in specific calendars
  • Convertor Pro: convert any kind of sizes, currencies, dates, time, etc
  • Mantano Reader: ebook and pdf reader with good options and compatible with most formats
  • Google translate: translate text
  • Kingsoft Office: excellent MS Office document viewer and editor , free!
  • NeverLate: traffic information

Besides those, some other standard well know applications known by everyone (eg facebook, gmail, whatsapp, youtube, etc).

Wednesday, September 21, 2011

USB drive daily usage: encrypt & sync

As I described in a previous post, I advise the Rohos Mini Drive to be used on a USB Stick for daily usage. It does everything you can expect from an encryption tool, but has the benefit to have a unique non-admin account support with Rohos Disk Browser. But for a user friendly daily usage of a USB drive, an automated synchronization process is required on top of a safe encryption mechanism: you always want the latest version of your files to be available on your own pc and USB stick. If you change anything on any location, all files should get updated immediately.

For this I combine the strength of Rohos Mini Drive with GoodSync. GoodSync can be configured to monitor if a USB stick is attached to your system. If it detects the encrypted disk, it needs to launch the Rohos Mini Drive to give access to the encrypted files. Once the encrypted files are accessible by your PC, the files should be synchronized automatically. Since Rohos Mini Drive provides access to the files as a new virtual disk, GoodSynch can be configured to be launched as soon as this virtual disk becomes available. And at that moment, the full synchronization features of GoodSync can be started to make sure all latest versions of your files are available on your PC and on your USB stick.

So the only missing part in this process, was the need to launch Rohos Mini Drive and mount the virtual disk automatically. I solved this using the little batch script below. It will find the correct drive, launch Rohos Mini Drive to mount the encrypted disk. The user will need to provide the password. Once the correct password is provided, the encrypted drive will be mounted (become available in Windows Explorer).

GoodSync is configured to launch the batch script as soon as the USB stick is connected. The batch script will mount the encrypted disk and another GoodSync job will detect this virtual encrypted disk to become available. In this GoodSync job, the synchronisation of the local folder and encrypted USB Stick folder is configured.

Some screenshots of the different configurations:


@echo off
set USB_STICK_NAME=SET_PERSONAL_USB_STICK_NAME
set PROCESS_NAME=Rohos Mini.exe
tasklist /FI "IMAGENAME eq %PROCESS_NAME%" 2>NUL | find /I /N "%PROCESS_NAME%">NUL
if "%ERRORLEVEL%"=="0" GOTO ROHOS_RUNNING
GOTO ROHOS_NOT_RUNNING

:ROHOS_RUNNING
exit

:ROHOS_NOT_RUNNING
set _Target=NotFound

for /f usebackq %%a in (`Drives.exe -f %USB_STICK_NAME%`) do set _Target=%%a
if "%_Target%" == "NotFound" (
echo Unable to find target drive named "%USB_STICK_NAME%"
goto :EOF
)
start "Rohos" "%_Target%\%PROCESS_NAME%"
exit




Update 06/11/2012: I moved to using EncFS to encrypt my files on Windows/Cloud/Android instead of using Rohos Mini Drive. Rohos had some compatibility issues with Windows 7. This good blogpost describes all tools needed to get started with EncFS on different environments. I’m only missing a decent portable solution that could work without admin rights.

Monday, August 22, 2011

Batch parameter modifier

In batch script, one can use the following modifier to expand to full path etc.

%1 first parameter provided to the script.
%~1 Expands %1 and removes any surrounding quotation marks ("").
%~f1 Expands %1 to a fully qualified path name.
%~d1 Expands %1 to a drive letter.
%~p1 Expands %1 to a path.
%~n1 Expands %1 to a file name.
%~x1 Expands %1 to a file extension.
%~s1 Expanded path contains short names only.
%~a1 Expands %1 to file attributes.
%~t1 Expands %1 to date and time of file.
%~z1 Expands %1 to size of file.
%~$PATH:1 Searches the directories listed in the PATH environment variable and expands %1 to the fully qualified name of the first one found. If the environment variable name is not defined or the file is not found, this modifier expands to the empty string.
%~dp1 Expands %1 to a drive letter and path.
%~nx1 Expands %1 to a file name and extension.
%~dp$PATH:1 Searches the directories listed in the PATH environment variable for %1 and expands to the drive letter and path of the first one found.
%~ftza1 Expands %1 to a dir-like output line.
%cd% current working direcotry.
%~dp0 script directory.
%~dp0..\ parent of script direcotry.

SET Today=%Date: =0%
SET TodayYYYYMMDD=%Today:~-4%%Date:~-7,2%%Date:~-10,2%
SET Now=%Time: =0%

In the previous examples, you can replace %1 and PATH with other batch parameter values.

The %* modifier is a unique modifier that represents all arguments passed in a batch file. You cannot use this modifier in combination with the %~ modifier. The %~ syntax must be terminated by a valid argument value.

You cannot manipulate batch parameters in the same manner that you can manipulate environment variables. You cannot search and replace values or examine substrings. However, you can assign the parameter to an environment variable, and then manipulate the environment variable.