Sub Test()
  MsgBox abbrev("Projects-North America-Canada-Alberta-Moose Jaw")
End Sub

Function abbrev(aString$) As String
  Dim a, b, i As Integer
  a = Split(aString, "-")
  b = a
  For i = 0 To UBound(a)
    b(i) = Acronym(CStr(a(i)))
  Next i
  abbrev = Join(b, "-")
End Function

Function Acronym(str As String) As String
  Dim re As Object
  Set re = CreateObject("vbscript.regexp")
  re.Global = True
  re.Pattern = "(\w).*?(\W+|\s+|$)"
  Acronym = UCase(re.Replace(str, "$1"))
End Function