Wednesday, August 20, 2014

Outlook ReportItem trick to get ReportItem.SenderEmailAddress

Report Items  don't have any direct methods of getting the Reportitem..SenderEmailAddress that I have found- so here is a work around I did figure out...

    Select Case TypeName(objObject)
    Case "ReportItem"  
                            ''This is terrible- but the report item sender is not exposed...  
                            ''Is there a better way somewhere? API call maby?  
      Dim strFrom                 ''String for FROM email address  
      Dim msg As MailItem             ''container for reference mail item message  
      Set objReport = objObject          ''Set the report object to current mail item  
      Set msg = objReport.Actions.Item(1).Execute ''Execute a reply  
      strFrom = msg.Recipients.Item(1).Address   ''Get the resolved address from the 'to' of the reply  
      msg.Delete                  ''delete the unused draft  
End Select

Wednesday, July 16, 2014

shadow copies script to create a VSS folder and populate it with links to shadow copy volumes

Option Explicit

Const strFp = "C:\vss\" ''destination folder to hold VSS links to copies

Sub EnumerateShadows()
   Dim strComputer
   Dim objWMIService
   Dim snapshot, snapshots
   Dim foldername, strcmd

   Dim sdate
   Dim vdate ''As String

   Dim fso 'As FileSystemObject
   Set fso = CreateObject("Scripting.FileSystemObject")
 
   Dim WSHShell 'As WSHShell
   Set WSHShell = CreateObject("WScript.Shell")
 
   On Error GoTo fubar:
   If Not fso.FolderExists(strFp) Then fso.CreateFolder strFp

      strComputer = "desk014"
      Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
      Set snapshots = objWMIService.ExecQuery("Select * from Win32_ShadowCopy")
      For Each snapshot In snapshots
         sdate = snapshot.InstallDate
         vdate = Left(sdate, 4) & "-" & Mid(sdate, 5, 2) & "-" & Mid(sdate, 7, 2) & "-" & Mid(sdate, 9, 2) & Mid(sdate, 11, 2)
       
         strcmd = "mklink /d " & strFp & vdate & " " & snapshot.DeviceObject & "\"
       
         WSHShell.Run "cmd.exe /C " & strcmd, 0, True
       
      Next

      MsgBox "Completed see " & strFp
      Exit Sub
fubar:
      MsgBox "error"
End Sub

Saturday, June 14, 2014

For review

https://play.google.com/store/apps/details?id=pl.planmieszkania.android

For review

https://play.google.com/store/apps/details?id=se.inard.fp

For review

https://play.google.com/store/apps/details?id=com.construireonline.virtual.plan
Using a most excellent tool from (den4b called Renamer) -  pascal for determining either younger created date or modified and use that for the date time stamp.

var
  DateTime: TDateTime;

begin
  (*Sometimes saveas created a modified date which is younger than the Created date, use the youngest of the two*)
  if FileTimeCreated(FilePath) < FileTimeModified(FilePath) then
      DateTime := FileTimeCreated(FilePath)
  else
      DateTime := FileTimeModified(FilePath);
   
  (*SET THE FILENAME YYYY-MM-DD_HHMMa/p Plus the original filename*)
  FileName :=  FormatDateTime('yyyy-mm-dd_hhmm', DateTime) + FormatDateTime('a/p', DateTime)+ '-' + WideExtractBaseName(FileName) + WideExtractFileExt(FileName);
end.

Working with 2014-06-14-1506p here is a helpful Regexp to reorder it

Using a most excellent tool from (den4b called Renamer) - one of the few tools I happily purchased and want to promote it!

The regular expression to rearrange the date (helpful for date-stamping files) is:

(.*)([0-9]{4}[-_]{0,1}[0-1][0-9][-_]{0,1}[0-3][0-9])[-_]{0,1}([0-2][[0-9][0-5][0-9][a,p]{0,1}){0,1}[-]{0,1}(.*)
---1-----------------------------------------------2_________-------------------------------------3________----4

then it can be easily reordered:
$2-$3-$1-$4

For those of you unfamiliar with REGEX or ReGularEXpressions- it breaks down like this:


  • (.*)  =  $1
    • will match zero or more of any characters
    • By enclosing it in parenthesis () it becomes a sub expression. 
    • Since it is the first subexpression it can be referenced to be reordered with $1 in Renamer.
  • (   =  left parenthesis start of the second expression  $2  for the year-month-day
    • left parenthesis is the the start of the next expression to Capture. If the parenthesis weren't there the characters would match and be lost
    • [0-9]{4}  for the year 0000 through 9999
      • Square brackets [ ] enclose a set of characters for reference. 
      • 0-9 inside the brackets species a range of all characters 0 through 9
      • {4} Curled brackets indicate the number of characters to match in the previous expression.
      • By combining [0-9]{4} means 4 numbers, zero through nine- perfect for a date 2014
      • alternatively ([1-2]{1}[0-9]{3}) should cover the last century 1000 through 29
    • [-_]{0,1} is for a literal dash or underscore character - zero or one of
    • [0-1][0-9] for the month 
      • alternatively [0-1]{0,1}[0-9]  would allow for 06 or 6 for the month 

    • [-_]{0,1} is for a literal dash or underscore character
    • [0-3][0-9] for the day 01 through 39
      • alternatively [0-3]{0,1}[0-9]  would allow for a single digit day
  • ) =  right parenthesis END of the second expression  $2  for the year-month-day
  • [-_]{0,1} is for a literal dash or underscore character - zero or one of
  • (   =  left parenthesis start of the third expression  $3 
    • [0-2][0-9][0-5][0-9] = for time 0000 through 2959 (Covers through 2399 24 hour clock)
    • [am,a,p,pm]{0,1}  = zero or one of a, am, p, pm for  am pm--There is a glitch here I cannot figure out how to extend so it has the matching for am|a|pm|p - since the letters are the same it will not match the characters
  • ){0,1} = Right parenthesis END of the third expression $3 {0,1} means zero or one of these can exist
  • [-_]{0,1} is for a literal dash or underscore character - zero or one of
  • (.*) = $4 the 4th expression- the remainder (zero or more) of the remaining characters- in case the match is in front of the expression

Saturday, May 17, 2014

Printer selection problem due to Ne-port numbering

'Written: November 28, 2009
'Author:  Leith Ross
'Summary: Finds a printer by name and returns the printer name and port number.

Function FindPrinter(ByVal PrinterName As String) As String

 'This works with Windows 2000 and up
 
  Dim Arr As Variant
  Dim Device As Variant
  Dim Devices As Variant
  Dim Printer As String
  Dim RegObj As Object
  Dim RegValue As String
  Const HKEY_CURRENT_USER = &H80000001
       
    Set RegObj = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\default:StdRegProv")
    RegObj.enumvalues HKEY_CURRENT_USER, "Software\Microsoft\Windows NT\CurrentVersion\Devices", Devices, Arr
    
      For Each Device In Devices
        RegObj.getstringvalue HKEY_CURRENT_USER, "Software\Microsoft\Windows NT\CurrentVersion\Devices", Device, RegValue
        Printer = Device & " on " & Split(RegValue, ",")(1)
        If InStr(1, Printer, PrinterName, vbTextCompare) > 0 Then
           FindPrinter = Printer
           Exit Function
        End If
      Next
      
      
End Function

Thursday, May 15, 2014

Replace/remove s-voice on the Samsung Galaxy S3 (and hopefully noteII)



...a post in a forum (link) that gave me the missing link to getting “Bluetooth Launch” to work!  There were a few more steps to do:
  1. Open S-Voice and from the settings menu, un-check the option to launch with the home button. (Home2Shortcut takes over anyway).
  1. Open the phone “System settings” and goto “Applications manager”.  Swipe right twice to get to “All” and find S-Voice and disable it.
  1. Connect to your bluetooth headset/device with the screen unlocked and press the bluetooth button. This should cause a “Complete action using” dialog.  Here you can launch any application you want, including Google Search.
To automatically launch the google search with voice search activated, I found another handy app called “ICS Voice Search Shortcut” (link).
And there you go.  S-Voice replaced!
This was all done on a Samsung Galaxy S III LTE (I9305) with Jellybean 4.1.2.

Friday, April 25, 2014

Routine to automatically pull images and put in placeholders in powerpoint

So I had this issue the other night where a routine I have been using and tweaking over the past few years stopped working.  It is really relatively simple- about 150 lines of code but the core of the routine that put the images into the slides stopped working Monday. I am using office 365 x64 bit.

Figured it out how to get it working again - apparently there is a glitch in VBA - and an old approach started working again and by adding 0.1 second waits, the routine is working (so very odd). Being x64 office may be part of the issue, but it was working at the beginning of the year.
Here is the heart o the code that actually inserts the images:
    For Each ObjFile In ObjFolder.Files
        If ObjFile.Name Like "*.png" Then
            Set pre = Application.ActivePresentation
            ''This sets the slide type:
            Set ObjSlide = pre.Slides.Add(Index:=pre.Slides.Count + 1, Layout:=ppLayoutChart)
                ObjSlide.Shapes(1).TextFrame.TextRange = ObjFile.Name '' "Title of Slide"
            ''add the picture- which doesn't add it to the shape
            With ObjSlide.Shapes.AddPicture(FileName:=ObjFile.Path, LinkToFile:=msoFalse, _
                SaveWithDocument:=msoCTrue, Left:=0, Top:=0, Width:=-1, Height:=-1)
                ''then we CUT the image
                .Cut
            End With
            Wait 0.1
            ''this worked for a while but stooped a few months ago kindof works again...
            ''Have to activate the slide to select a placeholder
            ObjSlide.Select
            Wait 0.1
            ''Have to activate the slide again or it fails to select a placeholder
            ObjSlide.Select
            Wait 0.1
            ''This selects the name of the frame we want to use to put the image in -
            '' there are several of these
            ObjSlide.Shapes("Chart Placeholder 2").Select
            Wait 0.1
            ''paste the clipboard into the active placeholder
            ObjSlide.Shapes.Paste
        End If
    Next ObjFile
Here is the WAIT routine:
Sub Wait(Seconds As Double)
   Dim start
   start = Timer
   While Timer < start + Seconds
      DoEvents
   Wend
End Sub

Tuesday, April 22, 2014