Wed-nosed weindeer

It is again time for a wootoff.. the first one since the last one

For those of you who missed my previous post about wootoffs, now is your time to check that out

I'm busy at work, so I'm hoping no BOC until this afternoon when I get home, but hopefully you can score one if it is sooner.

VBScript - InStrRev and Format

Wow, big day for posts. Guess I am just waiting on a couple things; waiting to hear from the bigger boss about some more work for my transition (2 weeks left!) and waiting to hear from my love to see how her job interview went (could still be going on). But do you really care about any of that? I do, but I doubt you do. So I'm gonna post something about vbscript, something I love and think that more people should get into as it is quite flexible.

A very simple post to start out. For the most part, vbs can use the same methods and functions as vba/vb6, with slight modifications. The two biggest things missing, in my opinion, are Format() and InStrRev(). You can make a substitute function in VBS for the latter, however the former needs a bit more work and usually specific to your task at hand.

I'll get the easier one out of the way. I only use the two main arguments for this, but you can easily add something for the start position or even comparison type. If you want to use it, simply put this somewhere in your vbs file and call it as normal:

Function InStrRev(ByVal vStringCheck, ByVal vStringMatch)
 Dim i, iLen
 iLen = Len(vStringMatch)
 For i = Len(vStringCheck) To 1 Step -1
  If Mid(vStringCheck, i, iLen) = vStringMatch Then Exit For
 Next
 InStrRev = i
 Set i = Nothing
 Set iLen = Nothing
End Function

Simple, huh?
Next is using Format in VBS. As I said, you can't just use the function like Format(7, "000") as you can in VBA. What you can do, however, is manipulate strings to get it done easily (and use a function for it if you're going to do it multiple times).

To see a one-shot version of it, here is how you would write the above Format statement in VBS. Note that you would probably never go through this much code to write "007", but it should give you an idea of how it works. In essence, if you want it to be 3 digits, you're concatenating "000" to the value "7", then taking the right 3 digits of it:

 Dim TheValue, NumDigits, PaddedValue
 TheValue = 7
 NumDigits = 3
 PaddedValue = Right(String(NumDigits, "0") & TheValue, NumDigits)
 MsgBox PaddedValue

If you plan to do this multiple times, heres an example of how to format the current date in mm/dd/yyyy formation:

 MsgBox FormatPaddedZeroes(Month(Now), 2) & "/" & FormatPaddedZeroes(Day(Now), 2) & _
  "/" & FormatPaddedZeroes(Year(Now), 4)

Function FormatPaddedZeroes(ByVal TheValue, ByVal NumDigits)
 FormatPaddedZeroes = Right(String(NumDigits, "0") & TheValue, NumDigits)
End Function

I could write a post on all the similarities between VBA and VBS, but other than a few things they are very similar (just remove any types in VBS, and the 'main' subroutine doesn't need a Sub and End Sub).

My VBA Enum and Type library

Ok, part 3 of 3 of my reference. This will contain all the Enum and Type statements I use; I take no credit for any of these (I don't believe) as I'm sure I picked them up from others along the way, most likely MSDN.

Enum:

Public Enum SortOrder
  SortAscending = 0
  SortDescending = 1
End Enum
Public Enum RemoveFrom
  RemoveArray = 0
  RemoveIndex = 1
End Enum
Public Enum EOpenFile
  OFN_READONLY = &H1
  OFN_OVERWRITEPROMPT = &H2
  OFN_HIDEREADONLY = &H4
  OFN_NOCHANGEDIR = &H8
  OFN_SHOWHELP = &H10
  OFN_ENABLEHOOK = &H20
  OFN_ENABLETEMPLATE = &H40
  OFN_ENABLETEMPLATEHANDLE = &H80
  OFN_NOVALIDATE = &H100
  OFN_ALLOWMULTISELECT = &H200
  OFN_EXTENSIONDIFFERENT = &H400
  OFN_PATHMUSTEXIST = &H800
  OFN_FILEMUSTEXIST = &H1000
  OFN_CREATEPROMPT = &H2000
  OFN_SHAREAWARE = &H4000
  OFN_NOREADONLYRETURN = &H8000&
  OFN_NOTESTFILECREATE = &H10000
  OFN_NONETWORKBUTTON = &H20000
  OFN_NOLONGNAMES = &H40000
  OFN_EXPLORER = &H80000
  OFN_NODEREFERENCELINKS = &H100000
  OFN_LONGNAMES = &H200000
End Enum

Type:

Public Type OPENFILENAME
  lStructSize As Long
  hwndOwner As Long
  hInstance As Long
  lpstrFilter As String
  lpstrCustomFilter As String
  nMaxCustFilter As Long
  nFilterIndex As Long
  lpstrFile As String
  nMaxFile As Long
  lpstrFileTitle As String
  nMaxFileTitle As Long
  lpstrInitialDir As String
  lpstrTitle As String
  flags As Long
  nFileOffset As Integer
  nFileExtension As Integer
  lpstrDefExt As String
  lCustData As Long
  lpfnHook As Long
  lpTemplateName As String
End Type
Public Type BROWSEINFO
 hOwner As Long
 pidlRoot As Long
 pszDisplayName As String
 lpszTitle As String
 ulFlags As Long
 lpfn As Long
 lParam As Long
 iImage As Long
End Type
Public Type SECURITY_ATTRIBUTES
  nLength                 As Long
  lpSecurityDescription   As Long
  bInheritHandle          As Boolean
End Type
Public Type FILETIME
  dwLowDateTime As Long
  dwHighDateTime As Long
End Type
Public Type WIN32_FIND_DATA
  dwFileAttributes As Long
  ftCreationTime As FILETIME
  ftLastAccessTime As FILETIME
  ftLastWriteTime As FILETIME
  nFileSizeHigh As Long
  nFileSizeLow As Long
  dwReserved0 As Long
  dwReserved1 As Long
  cFileName As String * 218 'MAX_PATH
  cAlternate As String * 14
End Type
Type NOTIFYICONDATA
  cbSize As Long
  hwnd As Long
  uID As Long
  uFlags As Long
  uCallbackMessage As Long
  hIcon As Long
  szTip As String * 64 'MAX_TOOLTIP
End Type

VBA Const values

Part 2 of 3 of (my) reference posts.. These are less important to have handy than others, since in any language, a value is a value is a value. Easy enough to make a new const statement in VBA. However, these are the constants that my code library needs in order to compile, so I'll post it here :)

Public Const BIF_BROWSEFORCOMPUTER = &H1000
Public Const BIF_BROWSEFORPRINTER = &H2000
Public Const BIF_BROWSEINCLUDEFILES = &H4000
Public Const BIF_DONTGOBELOWDOMAIN = &H2
Public Const BIF_EDITBOX = &H10
Public Const BIF_NEWDIALOGSTYLE = &H40
Public Const BIF_RETURNFSANCESTORS = &H8
Public Const BIF_RETURNONLYFSDIRS = &H1
Public Const BIF_STATUSTEXT = &H4
Public Const ERROR_ACCESS_DENIED = 8
Public Const ERROR_ARENA_TRASHED = 7
Public Const ERROR_BADDB = 1
Public Const ERROR_BADKEY = 2
Public Const ERROR_CANTOPEN = 3
Public Const ERROR_CANTREAD = 4
Public Const ERROR_CANTWRITE = 5
Public Const ERROR_NONE = 0
Public Const ERROR_NOT_FOUND As Long = &H80000000
Public Const ERROR_OUTOFMEMORY = 6
Public Const HKEY_CLASSES_ROOT = &H80000000
Public Const HKEY_CURRENT_USER = &H80000001
Public Const HKEY_LOCAL_MACHINE = &H80000002
Public Const HKEY_USERS = &H80000003
Public Const REG_DWORD      As Long = 4
Public Const REG_SZ         As Long = 1
Public Const MAX_PATH As Long = 218
Public Const MAX_TOOLTIP As Long = 64
Public Const SM_CXSCREEN = 0

VBA APIs

This is as much for my benefit while traveling as it hopefully will be for yours, but the following is a list of my most-used APIs. I know there are plenty of sites out there that offer the same information, but many times they are not formatted to my liking or they offer it in another language which I have to convert to VBA. This should at least make it a little easier when looking for a specific API.

This is also going to be post 1 of 3 of this sort of information; I will also (likely very shortly) be posting some of my commonly used CONST values as well as Enum setups.

Public Declare Function CallWindowProc Lib "user32.dll" Alias "CallWindowProcA" (ByVal _
  lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, _
  ByVal lParam As Long) As Long

Public Declare Function CloseClipboard Lib "user32.dll" () As Long

Public Declare Function EmptyClipboard Lib "user32.dll" () As Long

Public Declare Function ExtractIcon Lib "shell32.dll" Alias "ExtractIconA" (ByVal _
  hInst As Long, ByVal lpszExeFileName As String, ByVal nIconIndex As Long) As Long

Public Declare Function FindClose Lib "kernel32.dll" (ByVal hFindFile As Long) As Long

Public Declare Function FindFirstFile Lib "kernel32.dll" Alias "FindFirstFileA" (ByVal _
  lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long

Public Declare Function FindNextFile Lib "kernel32.dll" Alias "FindNextFileA" (ByVal _
  hFindFile As Long, lpFindFileData As WIN32_FIND_DATA) As Long

Public Declare Function FindWindow Lib "user32.dll" Alias "FindWindowA" (ByVal _
  lpClassName As String, ByVal lpWindowName As String) As Long

Public Declare Function FtpCreateDirectory Lib "wininet.dll" Alias _
  "FtpCreateDirectoryA" (ByVal hFtpSession As Long, ByVal lpszDirectory As String _
  ) As Boolean

Public Declare Function FtpDeleteFile Lib "wininet.dll" Alias "FtpDeleteFileA" (ByVal _
  hFtpSession As Long, ByVal lpszFileName As String) As Boolean

Public Declare Function FtpFindFirstFile Lib "wininet.dll" Alias "FtpFindFirstFileA" _
  (ByVal hFtpSession As Long, ByVal lpszSearchFile As String, lpFindFileData As _
  WIN32_FIND_DATA, ByVal dwFlags As Long, ByVal dwContent As Long) As Long

Public Declare Function FtpGetCurrentDirectory Lib "wininet.dll" Alias _
  "FtpGetCurrentDirectoryA" (ByVal hFtpSession As Long, ByVal lpszCurrentDirectory _
  As String, lpdwCurrentDirectory As Long) As Long

Public Declare Function FtpGetFile Lib "wininet.dll" Alias "FtpGetFileA" (ByVal _
  hConnect As Long, ByVal lpszRemoteFile As String, ByVal lpszNewFile As String, _
  ByVal fFailIfExists As Long, ByVal dwFlagsAndAttributes As Long, ByVal dwFlags _
  As Long, ByRef dwContext As Long) As Boolean

Public Declare Function FtpPutFile Lib "wininet.dll" Alias "FtpPutFileA" (ByVal _
  hConnect As Long, ByVal lpszLocalFile As String, ByVal lpszNewRemoteFile As _
  String, ByVal dwFlags As Long, ByVal dwContext As Long) As Boolean

Public Declare Function FtpRemoveDirectory Lib "wininet.dll" Alias _
  "FtpRemoveDirectoryA" (ByVal hFtpSession As Long, ByVal lpszDirectory As String) _
  As Boolean

Public Declare Function FtpRenameFile Lib "wininet.dll" Alias "FtpRenameFileA" (ByVal _
  hFtpSession As Long, ByVal lpszExisting As String, ByVal lpszNew As String) As Boolean

Public Declare Function FtpSetCurrentDirectory Lib "wininet.dll" Alias _
  "FtpSetCurrentDirectoryA" (ByVal hFtpSession As Long, ByVal lpszDirectory As _
  String) As Boolean

Public Declare Function GetClipboardData Lib "user32.dll" (ByVal wFormat As Long) As Long

Public Declare Function GetDC Lib "user32.dll" (ByVal hwnd As Long) As Long

Public Declare Function GetDeviceCaps Lib "gdi32.dll" (ByVal hDC As Long, ByVal _
  nIndex As Long) As Long

Public Declare Function GetFileAttributes Lib "kernel32.dll" Alias _
  "GetFileAttributesA" (ByVal lpFileName As String) As Long

Public Declare Function GetOpenFileNameB Lib "comdlg32.dll" Alias _
  "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long

Public Declare Function GetQueueStatus Lib "user32.dll" (ByVal fuFlags As Long) As Long

Public Declare Function GetSaveFileNameB Lib "comdlg32.dll" Alias _
  "GetSaveFileNameA" (pOpenfilename As OPENFILENAME) As Long

Public Declare Function GetSystemMetrics Lib "user32.dll" (ByVal nIndex As Long) As Long

Public Declare Function GlobalAlloc Lib "kernel32.dll" (ByVal wFlags&, ByVal _
  dwBytes As Long) As Long

Public Declare Function GlobalLock Lib "kernel32.dll" (ByVal hMem As Long) As Long

Public Declare Function GlobalSize Lib "kernel32.dll" (ByVal hMem As Long) As Long

Public Declare Function GlobalUnlock Lib "kernel32.dll" (ByVal hMem As Long) As Long

Public Declare Function InternetCloseHandle Lib "wininet.dll" (ByVal hInet _
  As Long) As Long

Public Declare Function InternetConnect Lib "wininet.dll" Alias "InternetConnectA" _
  (ByVal hInternetSession As Long, ByVal sServerName As String, ByVal nServerPort _
  As Integer, ByVal sUserName As String, ByVal sPassword As String, ByVal lService _
  As Long, ByVal lFlags As Long, ByVal lContext As Long) As Long

Public Declare Function InternetFindNextFile Lib "wininet.dll" Alias _
  "InternetFindNextFileA" (ByVal hFind As Long, lpvFindData As WIN32_FIND_DATA) As Long

Public Declare Function InternetGetLastResponseInfo Lib "wininet.dll" Alias _
  "InternetGetLastResponseInfoA" (lpdwError As Long, ByVal lpszBuffer As String, _
  lpdwBufferLength As Long) As Boolean

Public Declare Function InternetOpen Lib "wininet.dll" Alias "InternetOpenA" (ByVal _
  sAgent As String, ByVal lAccessType As Long, ByVal sProxyName As String, ByVal _
  sProxyBypass As String, ByVal lFlags As Long) As Long

Public Declare Function InternetOpenUrl Lib "wininet.dll" Alias "InternetOpenUrlA" _
  (ByVal hOpen As Long, ByVal sUrl As String, ByVal sHeaders As String, ByVal lLength _
  As Long, ByVal lFlags As Long, ByVal lContext As Long) As Long

Public Declare Function InternetReadFile Lib "wininet.dll" (ByVal hFile As Long, ByVal _
  sBuffer As String, ByVal lNumBytesToRead As Long, lNumberOfBytesRead As Long) As Long

Public Declare Function KillTimer Lib "user32.dll" (ByVal hwnd As Long, ByVal nIDEvent _
  As Long) As Long

Public Declare Function lstrcpy Lib "kernel32.dll" (ByVal lpString1 As Any, ByVal _
  lpString2 As Any) As Long

Public Declare Function lstrlen Lib "kernel32.dll" Alias "lstrlenA" (ByVal lpString _
  As String) As Long

Public Declare Function OpenClipboard Lib "user32.dll" (ByVal hwnd As Long) As Long

Public Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long

Public Declare Function RegCreateKeyEx Lib "advapi32.dll" Alias "RegCreateKeyExA" _
  (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal _
  lpClass As String, ByVal dwOptions As Long, ByVal samDesired As Long, _
  lpSecurityAttributes As SECURITY_ATTRIBUTES, phkResult As Long, lpdwDisposition _
  As Long) As Long

Public Declare Function RegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA" _
  (ByVal hKey As Long, ByVal lpValueName As String) As Long

Public Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal _
  hKey As Long, ByVal lpValueName As String, phkResult As Long) As Long

Public Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" (ByVal _
  hKey As Long, ByVal lpValueName As String, ByVal ulOptions As Long, ByVal _
  samDesired As Long, phkResult As Long) As Long

Public Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" _
  (ByVal hKey As Long, ByVal lpValueName As String, lpReserved As Long, lpType As _
  Long, ByVal lpData As String, lpcbData As Long) As Long

Public Declare Function RegSetValueEx Lib "advapi32.dll" Alias "RegSetValueExA" _
  (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal _
  dwType As Long, lpData As Any, ByVal cbData As Long) As Long

Public Declare Function ReleaseDC Lib "user32.dll" (ByVal hwnd As Long, ByVal hDC _
  As Long) As Long

Public Declare Function SetClipboardData Lib "user32.dll" (ByVal wFormat As Long, _
  ByVal hMem As Long) As Long

Public Declare Function SetDefaultPrinter Lib "winspool.drv" Alias "SetDefaultPrinterA" _
  (ByVal pszPrinter As String) As Long

Public Declare Function SetForegroundWindow Lib "user32.dll" (ByVal hwnd As Long) As Long

Public Declare Function SetTimer Lib "user32.dll" (ByVal hwnd As Long, ByVal nIDEvent _
  As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long

Public Declare Function SetWindowLong Lib "user32.dll" Alias "SetWindowLongA" (ByVal _
  hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long

Public Declare Function SetWindowPos Lib "user32.dll" (ByVal hwnd As Long, ByVal _
  hWndInsertAfter As Long, ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal _
  cy As Long, ByVal wFlags As Long) As Long

Public Declare Function SHBrowseForFolder Lib "shell32.dll" Alias "SHBrowseForFolderA" _
  (lpBrowseInfo As BROWSEINFO) As Long

Public Declare Function Shell_NotifyIcon Lib "shell32.dll" Alias "Shell_NotifyIconA" _
  (ByVal dwMessage As Long, lpData As NOTIFYICONDATA) As Long

Public Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal _
  hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal _
  lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long

Public Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias _
  "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long

Public Declare Function ShowWindow Lib "user32.dll" (ByVal hwnd As Long, ByVal _
  nCmdShow As Long) As Long

Public Declare Function URLDownloadToFile Lib "urlmon.dll" Alias "URLDownloadToFileA" _
  (ByVal pCaller As Long, ByVal szURL As String, ByVal szFilename As String, ByVal _
  dwReserved As Long, ByVal lpfnCB As Long) As Long

Public Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (ByRef lpDest _
  As Any, ByRef lpSource As Any, ByVal iLen As Long)

Public Declare Sub keybd_event Lib "user32.dll" (ByVal bVk As Byte, ByVal bScan As _
  Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)

Public Declare Sub Sleep Lib "kernel32.dll" (ByVal dwMilliseconds As Long)

Public Declare Function adh_apiGetTime Lib "winmm.dll" Alias "timeGetTime" () As Long

Public Declare Function IsCharAlphaNumeric Lib "User32" Alias "IsCharAlphaNumericA" _
  (ByVal cChar As Byte) As Long

Accessing GMail IMAP from Verizon's Mobile Email

Before I get into the real topic at hand, I'll give you the backstory about why I had to get a new phone. To skip to the gmail / mobile email portion, skip ahead 2 paragraphs to the bold "Mobile Email" heading.

About a year ago, my old phone (motorola E815) started having issues with the charging port, in that it would randomly reset every few seconds while charging so it wouldn't actually charge anything. I found a way around it, keeping the plug on a slight angle, etc, and was able to still have it charged every few days (as long as the battery would last me). Sometime this past March even that stopped working, so I went on ebay, bought an extended life battery for my phone, a new back cover for it, and a charger that would charge the battery itself rather than the phone. This worked out very well, aside from the minor inconvenience of switching batteries which I had to do every week or so (good battery life!).

Well, last Saturday (May 31), I woke up to an almost dead phone, after putting in a charged battery on Friday morning. I didn't know why it happened, but maybe it just didn't charge right or something, I just wrote it off as a fluke. So I charged my extended battery, and a couple hours later I put that in after it was ready. Sunday morning I woke up to a dead battery again, which I didn't realize until late afternoon Sunday because I had no reason to look at my phone. Charged the other battery, put it in, and woke up Monday to a totally dead phone. Did the same song and dance, but now the batteries didn't seem to last longer than 10-12 hours. Tuesday evening I had enough, so I went into Verizon for them to take a look at it. They said this happens with older batteries, I said I just got this battery in March, they said this could happen with older phones and maybe the circuitry fried or something. I don't know why it would work for a few hours instead of not-at-all (especially after lasting a week last week, but who knows). The only thing I've done at all lately was sign up for the Backup Assistant to run 30 seconds each night, which Verizon swears wouldn't run longer than that. Maybe they just sent a signal to my phone to stop working so I'd have to get a new phone/contract. So I sucked it up, rewewed my 2 year contract, and after looking at all sorts of options, and researching all my options at home, I went back and I got an LG enV2 (VX9100).


Mobile Email
My phone had the option of using Verizon's "Mobile Email" application for email, and since I have a fancy(ish) new phone I might as well use it, see how it works. As I think I've previously said, I use gmail to consolidate all my other email accounts, so I only have to check it via IMAP for a synchronized view of my email from any pc. Really great stuff.

Well, I opened the app, entered my gmail username/password to sign in, and got a "Invalid account details. Please try again" error. I looked online to make sure the app would work with IMAP, and everything said it would. Tried again, same error. Not sure why I thought it might work the second time, maybe it was out of disbelief.

I then found a post on howardforums.com from someone who shared the same error I got. What they discovered was when logging in, instead of using your @gmail.com address, use @googlemail.com instead and it will prompt you for the settings while logging in. It worked!!

To save you the trouble of looking on that page for instructions and then going to gmail's imap settings page, here is what you'll have to change on the setup screen:

Email Address:         
[e.mail@googlemail.com]

Password:              
********************   
[X]Save password       

Username:              
[e.mail@gmail.com]     -- Enter gmail address here
[ ]POP3                
[X]IMAP                -- Check this              

Incoming Mail Server:  
[imap.gmail.com]       -- Enter this server       
Incoming Port:         
[993]                  -- Enter this port         
[ ]None                
[X]SSL                 -- Check this              
[ ]TLS                 

Outgoing Mail Server:  
[smtp.gmail.com]       -- Enter this server       
Outgoing Port:         
[465]                  -- Enter this port         
[ ]None                
[X]SSL                 -- Check this              
[ ]TLS                 
[X]Requires Login      -- Should already be checked

While playing with it the past couple hours, seems WELL worth the $5/mo, if email is important to you. If you're unsure, try it for a month, you have little to lose :)

For those curious, this is what my phone looks like. Click the picture for the specs at phonescoop:

AddIns - Creating menu options

Well, I just realized I posted my FoundRange function as part of an earlier post (maybe my Burst function). That isn't exactly fair to you now is it. So here is what I put in my ThisWorkbook object for any add-in I write (non-office2007) to create menus/submenus. The comments in the code should be enough for you, but if you have any questions about it please post a comment!

Option Explicit
'I use this as a basis for the code in ThisWorkbook of most add-ins that I make
' -MenuCaption is the menu in the worksheet menu bar to add to. Feel free to create
'  your own menu, or use an existing menu (using the & symbol for the alt-key shortcut)
'  For example, to add your new option(s) to the 'Tools' menu, use &Tools
' -MenuOption1 and MenuOption1MacroName are used for the individual menu options
'  For additional options, follow the same guideline as MenuOption1, and make sure to
'  reference your new Const'ants in the Workbook_Open and RemoveMenuOption subroutines
Private Const MenuCaption As String = "&New Menu"
Private Const MenuOption1 As String = "&Menu Option"
Private Const MenuOption1MacroName As String = "MacroName"

Private Sub Workbook_Open()
 Dim CmdBar As Object, NewMenu As Object, NewSubMenu As Object
 
 RemoveMenuOption
 On Error Resume Next
 Set CmdBar = Application.CommandBars("Worksheet Menu Bar")
 Set NewMenu = AddMenu(CmdBar, MenuCaption)

''Use syntax like this for a sub-menu
' Set NewSubMenu = AddMenu(NewMenu, MenuName1)
' AddControl NewSubMenu, MenuOption1_1, MenuOption1_1MacroName
' AddControl NewSubMenu, MenuOption1_2, MenuOption1_2MacroName
 
'Otherwise use this syntax
 AddControl NewMenu, MenuOption1, MenuOption1MacroName
End Sub

Private Function AddMenu(ByRef ParentMenu As Object, ByVal NewMenuName As String) As Object
 Dim vNewMenu As Object
 On Error Resume Next
 Set vNewMenu = ParentMenu.Control(Replace(NewMenuName, "&", ""))
 If vNewMenu Is Nothing Then
  Set vNewMenu = ParentMenu.Controls.Add(Type:=10, Before:=ParentMenu.Controls.Count + 1 _
   , Temporary:=True)   '10=msoControlPopup
  vNewMenu.Caption = NewMenuName
 End If
 Set AddMenu = vNewMenu
End Function

Private Function AddControl(ByRef NewMenu As Object, ByVal vOption As String, _
  ByVal vOptionMacro As String, Optional ByVal vBeginGroup As Boolean = False) As Boolean
 With NewMenu.Controls.Add
  .Caption = vOption
  .BeginGroup = vBeginGroup
  .OnAction = "'" & ThisWorkbook.Name & "'!" & vOptionMacro
  .Tag = Replace(vOption, "&", "")
 End With
End Function

Private Sub Workbook_AddinUninstall()
 RemoveMenuOption
 If Not ThisWorkbook.Saved Then ThisWorkbook.Save
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
 If Not ThisWorkbook.Saved Then ThisWorkbook.Save
End Sub

Private Sub RemoveMenuOption()
 Dim cBc2 As Object, cBc As Object
 On Error Resume Next
 For Each cBc In Application.CommandBars("Worksheet Menu Bar").Controls
  If Replace(cBc.Caption, "&", "") = Replace(MenuCaption, "&", "") Then
   For Each cBc2 In cBc.Controls
    Select Case LCase(Replace(cBc2.Caption, "&", ""))
     Case LCase(Replace(MenuOption1, "&", "")):  cBc2.Delete
     'add more additional Case statements here as you add more MenuOptions
    End Select
   Next
   If cBc.Controls.Count = 0 Then cBc.Delete
   Exit For
  End If
 Next cBc
End Sub

Miss me?

Sorry I've been away so long. As you probably know, I'm losing my job at the end of June. My department is being moved to our corporate office in Stamford, CT, and the group taking our work has been a little slow on learning how to do things (we were first told in September about our impending job loss). Now that the time is getting closer and closer, that group is realizing they have a lot more to learn than they thought (i think they thought we did nothing) and on top of me still doing my job I am now showing them how to do it as well.

Plus, with me leaving in 3 1/2 weeks, some people here in my Rochester office are trying to suck me dry of all sorts of excel and automation info. I enjoy that, but I wish I had more time in the day. But it has been fun, giving people some excel classes, both to groups as a group level (usually basic) as well as a one-on-one level. I have given a few classes here and there for people within my building before, but I am really starting to enjoy it. I wish I could do it full time! Maybe I'll play the lottery and hope to strike it big, so I can teach people for free for the rest of my life.

I know some of you think I'm crazy for that. Why not try and get paid for it? Well, for one, I just love to help people. It's why I love the forums. Beyond that, I live in a smaller market (200,000 people in the city of Rochester, 1-1.5mil in the metro area) and I don't think there is much interest. Then again, I'm probably wrong, so I'll have to look into that. Then again, if I move out of the area (looking at the DC area) I'd probably have many more opportunities. Of course an area like that probably has job openings for people like me, not for training but for automation/etc.

Either way, just wanted to give a reason why I've been gone. I did realize one nice thing about teaching people things: you learn stuff yourself. Someone showed me an XP keyboard shortcut (I'm a total keyboard guy), I believe it was alt-up-up or alt-down-down, I don't remember at the moment as I'm on a win2k machine. It wasn't anything earth shattering by any means, but always good to learn new stuff :) Another one I found was Alt-Home to go to the home page in a browser. Makes perfect sense, but oddly I never knew it existed; I use it all the time now.

I'll try and post some more tonight, I've been exhausted in the evenings but I should start trying to do more.

And for a treat for you, I'm gonna post a subroutine I wrote a while ago that I still love. It is very simple, it just returns a list of all "found" cells in a specified range as a range object. Very useful :)

Function FoundRange(ByVal vRG As Range, ByVal vVal) As Range
 Dim FND As Range, FND1 As Range
 Set FND = vRG.Find(vVal, LookIn:=xlValues, LookAt:=xlWhole)
 If Not FND Is Nothing Then
  Set FoundRange = FND
  Set FND1 = FND
  Set FND = vRG.FindNext(FND)
  Do Until FND.Address = FND1.Address
   Set FoundRange = Union(FoundRange, FND)
   Set FND = vRG.FindNext(FND)
  Loop
 End If
End Function

Unrelated to VBA, I wanted to give an update for mario kart wii. I got it when it first came out, and played the hell out of it for a week. So much so that my wrists started hurting :( So I have only played it I think twice since then, and both times were less than a half hour. Maybe I'll buy a gamecube controller to play it during my upcoming mini-retirement (aka: severance) to avoid further damage.

Busy days

Well, my workdays are going to be very busy the next few days so you'll likely see very little of me (except when I need a break). In the meantime, however, here are the lyrics to a spoken-word song named Talk To Strangers by Saul Williams. I have this song in my head, so I thought I'd share here. I love the underlying point to it, so don't let the wall-of-text or the initial lines scare you away. The meaning behind it is worth the length. My apologies to Mr Williams if I have any incorrect lyrics.


Now I wasn’t raised at gunpoint and I’ve read too many books
To distract me from the mirror when unhappy with my looks
And I ain’t got proper diction for the makings of a thug
Though I grew up in the ghetto and my n----s all sold drugs
And though that may validate me for a spot on MTV
Or get me all the airplay that my bank account would need
I was hoping to invest in a lesson that I learned
And I thought this fool had jumped me just because it was my turn
I went to an open space 'cause I knew he wouldn’t do it
If somebody there could see him or somebody else might prove it
And maybe, in your eyes, it may seem I got punked out
Cause I walked a narrow path and then went and changed my route
But that openness exposed me to a truth I couldn’t find
In the clenched fists of my ego or the confines of my mind
In the hipness of my swagger, or the swagger in my step
Or the scowl of my grimace, or the meanness of my rep
Cause we represent a truth, son, that changes by the hour
And when you're open to it, formability is power
And in that shifting form you’ll find a truth that doesn’t change
And that truth is living proof of the fact that God is strange

Talk to strangers when family fails and friends lead you astray
When Buddha laughs and Jesus weeps and turns out God is gay
Cause angels' and messiahs' love can come in many forms
In the hallways of your projects or the fat girl in your dorm
And when you finally take the time to see what they’re about
Perhaps you find them lonely or their wisdom trips you out

Maybe you’ll find the cycles end you back where you began
But come this time around you’ll have someone to hold your hand
Who prays for you who's there for you who sends you love and light
Exposes you to parts of you that you once tried to fight
And come this time around you'll choose to walk a different path
You'll embrace what you turned away and cry at what you laughed
Cause that’s the only way we’re going to make it through this storm
Where ignorance is common sense and senselessness is the norm
And flags wave high above the truth and the two never touch
And stolen goods are overpriced and freedom costs too much
And no one seems to recognize the symbols come to life
The bitten apple on the screen and Jesus had a wife
And she was his Messiah like that stranger may be yours
Who holds a subtle knife that carves through worlds like magic doors
And that’s what I’ve been looking for, the bridge from then to now
Just watching BET like, "What the fuck, son? This is foul."
But that square box don't represent the sphere that we live in
The earth is not a flat screen, I ain’t trying to fit in
But this ain’t for the underground, this here is for the sun
A seed a stranger gave to me and planted on my tongue
And when I look at you, I know I’m not the only one
As a great man once said,
"There’s nothing more powerful than an idea who’s time has come."

Minimize userform to system tray

During the course of any VBA developer's life, the desire to want to be able to make a form seem independent of Excel will appear. One nice way to do this is to hide the excel application, so only a userform appears, but it doesnt usually seem the same. One nice thing that can be done to improve the looks (and possible functionality) is to minimize a userform to the system tray. An actual need to do this rarely comes up, but is usually impressive anyways depending on the end user.

I would like to say for the record that I did not create this code. I found some snippets that others had written in the past, and adapted it for my example. As usual, I researched exactly what it is doing so that I can write something similar from scratch as well as help others with any problems they have doing the same. I really don't remember who wrote the initial code that I adapted this from though. If you know, please let me know so I can give them proper credit.

Anyways, this is a pretty simple concept. Create a userform (called UserForm1), and add 2 commandbuttons to it. Keep them at their default name as well. Inside the codepane for the userform, paste the following:

'******************************************************'
'**************** START USERFORM1 CODE ****************'
'******************************************************'
Option Explicit
Private Sub CommandButton1_Click()
 Dim Me_hWnd As Long, Me_Icon As Long, Me_Icon_Handle As Long, IconPath As String
 Me_hWnd = FindWindowd("ThunderDFrame", UserForm1.Caption)
 IconPath = Application.Path & Application.PathSeparator & "excel.exe"
 Me_Icon_Handle = ExtractIcond(0, IconPath, 0)
 Hook Me_hWnd
 AddIconToTray Me_hWnd, 0, Me_Icon_Handle, "Double Click to re-open userform"
 Me.Hide
End Sub

Private Sub CommandButton2_Click()
 Application.Visible = True
 Unload Me
End Sub

Private Sub UserForm_Activate()
 RemoveIconFromTray
 Unhook
End Sub

Private Sub UserForm_Initialize()
 CommandButton1.Caption = "Minimize to tray"
 CommandButton2.Caption = "Close this form"
 Application.Visible = False
End Sub
'******************************************************'
'***************** END USERFORM1 CODE *****************'
'******************************************************'

Then insert a new module in the same project, and paste in the following:

'******************************************************'
'***************** START MODULE CODE ******************'
'******************************************************'
Option Explicit
Declare Function SetForegroundWindow Lib "User32" (ByVal hwnd As Long) As Long
Declare Function Shell_NotifyIcon Lib "shell32.dll" Alias "Shell_NotifyIconA" ( _
  ByVal dwMessage As Long, lpData As NOTIFYICONDATA) As Long
Declare Function CallWindowProc Lib "User32" Alias "CallWindowProcA" (ByVal _
  lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam _
  As Long, ByVal lParam As Long) As Long
Declare Function SetWindowLong Lib "User32" Alias "SetWindowLongA" (ByVal hwnd _
  As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Declare Function FindWindow Lib "User32" Alias "FindWindowA" (ByVal lpClassName _
  As String, ByVal lpWindowName As String) As Long
Declare Function ExtractIcon Lib "shell32.dll" Alias "ExtractIconA" (ByVal hInst _
  As Long, ByVal lpszExeFileName As String, ByVal nIconIndex As Long) As Long

Public Const WM_LBUTTONDOWN = &H201
Public Const WM_LBUTTONUP = &H202
Public Const WM_LBUTTONDBL = &H203
Public Const WM_RBUTTONDOWN = &H204
Public Const WM_RBUTTONUP = &H205
Public Const WM_ACTIVATEAPP = &H1C
Public Const NIF_ICON = &H2
Public Const NIF_MESSAGE = &H1
Public Const NIF_TIP = &H4
Public Const NIM_ADD = &H0
Public Const NIM_DELETE = &H2
Public Const MAX_TOOLTIP As Integer = 64
Public Const GWL_WNDPROC = (-4)

Type NOTIFYICONDATA
 cbSize As Long
 hwnd As Long
 uID As Long
 uFlags As Long
 uCallbackMessage As Long
 hIcon As Long
 szTip As String * MAX_TOOLTIP
End Type

Public nfIconData As NOTIFYICONDATA

Private FHandle As Long
Private WndProc As Long
Private Hooking As Boolean

Public Sub Hook(Lwnd As Long)
 If Hooking = False Then
  FHandle = Lwnd
  WndProc = SetWindowLong(Lwnd, GWL_WNDPROC, AddressOf WindowProc)
  Hooking = True
 End If
End Sub

Public Sub Unhook()
 If Hooking = True Then
  SetWindowLong FHandle, GWL_WNDPROC, WndProc
  Hooking = False
 End If
End Sub

Public Function WindowProc(ByVal hw As Long, ByVal uMsg As Long, ByVal wParam _
  As Long, ByVal lParam As Long) As Long
 If Hooking Then
  If lParam = WM_LBUTTONDBL Then
   UserForm1.Show 1
   WindowProc = True
'   Unhook
   Exit Function
  End If
  WindowProc = CallWindowProc(WndProc, hw, uMsg, wParam, lParam)
 End If
End Function
 
Public Sub RemoveIconFromTray()
 Shell_NotifyIcon NIM_DELETE, nfIconData
End Sub

Public Sub AddIconToTray(MeHwnd As Long, MeIcon As Long, MeIconHandle As Long, _
  Tip As String)
 With nfIconData
  .hwnd = MeHwnd
  .uID = MeIcon
  .uFlags = NIF_ICON Or NIF_MESSAGE Or NIF_TIP
  .uCallbackMessage = WM_RBUTTONUP
  .hIcon = MeIconHandle
  .szTip = Tip & Chr$(0)
  .cbSize = Len(nfIconData)
 End With
 Shell_NotifyIcon NIM_ADD, nfIconData
End Sub

Function FindWindowd(ByVal lpClassName As String, ByVal lpWindowName As String) As Long
 FindWindowd = FindWindow(lpClassName, lpWindowName)
End Function

Function ExtractIcond(ByVal hInst As Long, ByVal lpszExeFileName As String, ByVal _
  nIconIndex As Long) As Long
 ExtractIcond = ExtractIcon(hInst, lpszExeFileName, nIconIndex)
End Function

Sub ShowUserForm()
 Application.Visible = False
 UserForm1.Show 1
End Sub
'******************************************************'
'****************** END MODULE CODE *******************'
'******************************************************'

To try this out, simply run the ShowUserForm subroutine. Pretty cool, huh? Of course this can be quickly ported to run in other office programs as well as vb6, but since I love Excel I see no reason to generalize it for the sake of this post :)

Heroes Happen Here

So yesterday, my fair city got a visit from Microsoft during their "HEROES happen {here}" campaign. They are celebrating/marketing the recent release (and upcoming release, in SQL Server's case) of 3 new versions of their products: Visual Studio 2008, Windows Server 2008, and MS SQL Server 2008. Back in February I received an email from my MVP Lead at MS saying that the HHH tour was going around the country, and if we wanted to attend any of them to sign up and let him know so he could notify the peeps running HHH. After a quick look at the list of cities, I realized Rochester was actually included, so how could I not go? I expected to be unemployed by this point (fyi, as of now, I'm on through June 30th), but knew that I wanted to go no matter what. So I signed up, and a week later received an email confirming my registration.

Skip forward 3 months to 3 nights ago, when I realized what the date was and that I had forgotten all about it. I had no expectations of what it was going to entail, but if I could help them out in any way, it would be a good experience. I secured the day off with my supervisor, and woke up early to make it at 7am for the registration (per my confirmation).

So I get to the convention center, see a couple registration desks and also see an MS employee just inside so I asked her what I should do. I then registered/signed in, and went off to find Gail who was running it to see what was in store for me. I eventually found her (it was still early, and she looked to be getting some fine touches done), so I introduced myself and asked what I could do to help. She walks me over to a table in the "ask an expert" area with a small sign on it saying Microsoft MVP. She said she planned on having me sit there, and answering any questions people may have. I was taken a little back, as I was just an Excel MVP and have only some experience with vs2008, certainly not enough to be an expert with it. I explained that I would do whatever she thought was best, but that I didn't really feel that I would be the best person for that job. She said she had wondered about it as well, but seemed happy nonetheless to have a real mvp there. Sure, I could tell my own "hero" story of how I went from lowly office worker to the local excel guru, and eventually an MVP. But in dealing with people who either develop full time, or work in the development field of some sort, why would a VBA programmer be anything special? So I asked her what else I could do.

At first, I was brought over to relieve one of the other people running the event who was helping out with registration. After a quick explanation of how registration works, I was there for a few hours. Once that became a little less hectic I was moved to a couple other areas there, such as a Speak Your Mind video booth where attendees could record their thoughts for Microsoft to see, as well as a few tasks here and there to make things run smoothly. I had a great time, got to meet many local people in the field as well as some more people from Microsoft (based out of the Boston area). I even stepped into a session on using vs2008 with MS Office, but quickly realized the presenter wasn't showing me anything new. Most of the people in there seemed genuinely interested in what he was doing and he certainly had a good vibe with the crowd, seemed like a big hit (which did give me a little hope that my skills could be used once my current job is over).

Overall, I had a good time and I'm happy I attended. I found it interesting (at least it felt so to me) that most of the MS employees had never come across an MVP before and seemed genuinely interested in my story and the whole MVP program. They all seemed to know about it, and had a good impression of it despite not knowing much of it. It had crossed my mind (both before, as well as after, that wonderful Summit in April) that only some groups (product teams, PR, marketing) had any interest in the MVP program and that other employees either knew nothing about it or didn't think that highly of it. I would have to say that after yesterday, I was wrong. None of them seemed to ever deal with an MVP before but all showed immediate respect for me. Perhaps that contributed to my enjoyment of the day, but I think if I had just signed up to attend and didn't help out at all (which I did for about 8 hours) I would have still thoroughly enjoyed myself. If you get a chance to attend one of these, by all means do! Good learning experience (so I heard from some attendees of the sessions I did not see), good networking opportunity, and of course good swag (pens, lunch coolers, normal attendees even got free copies of the software being introduced!)

If you get the chance to see this, or any software roll-out conference, by all means do. You won't regret it!

Looping through a directory, speed test

That last post got me thinking I should share my routine for checking the speeds of the various ways to loop through a folder (vb's Dir, FileSystemObject, findfile APIs, excel's application.filesearch). It also would be a good way to put those methods out here for people to use, if you so choose.
I want to warn that you should probably delete your temporary internet files and possibly even your temporary files if you plan on doing this to your root C drive.

First, the results.
On my root C drive
FSO took 109.047000000002 seconds, 32297 files found
DIR took 73.8910000000013 seconds, 32297 files found
FileSearch took 234.421999999998 seconds, 31727 files found
APIs took 87.999999999998 seconds, 32296 files found

On a network drive
FSO took 3.60899999999802 seconds, 133 files found
DIR took 1.59400000000128 seconds, 133 files found
FileSearch took 0.999999999996682 seconds, 133 files found
APIs took 2.12499999999668 seconds, 133 files found

Taking a bit of a step back, here is the same test on a much bigger network drive
FSO took 801.625000000002 seconds, 8006 files found
DIR took 200.782000000003 seconds, 8006 files found
FileSearch took 77.5940000000007 seconds, 8006 files found
APIs took 282.483999999998 seconds, 8006 files found

These are pretty consistent with my original findings of it, kinda interesting that filesearch would be so slow on a local drive but much faster on network shares. Either way, it reaffirms my belief that Dir is the better overall method (filesearch was discontinued, obviously only works in VBA). The slight disparity of file counts (on my local drive) does concern me, though I can only assume (without delving further into it) that a file's attribute (system, hidden, etc) has something to do with it.

Take a look at the code I use to test this, if you see any kind of flaw in my logic I'd love to hear about improving it. Give it a shot on your own computer and see how it works out for you, and post back your results if you'd like!

Option Explicit
Private Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" ( _
  ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function FindNextFile Lib "kernel32" Alias "FindNextFileA" ( _
  ByVal hFindFile As Long, lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function GetFileAttributes Lib "kernel32" Alias "GetFileAttributesA" ( _
  ByVal lpFileName As String) As Long
Private Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long
Private Const MAX_PATH = 260
Private Const MAXDWORD = &HFFFF
Private Const INVALID_HANDLE_VALUE = -1
Private Const FILE_ATTRIBUTE_ARCHIVE = &H20
Private Const FILE_ATTRIBUTE_DIRECTORY = &H10
Private Const FILE_ATTRIBUTE_HIDDEN = &H2
Private Const FILE_ATTRIBUTE_NORMAL = &H80
Private Const FILE_ATTRIBUTE_READONLY = &H1
Private Const FILE_ATTRIBUTE_SYSTEM = &H4
Private Const FILE_ATTRIBUTE_TEMPORARY = &H100
Private Type FILETIME
 dwLowDateTime As Long
 dwHighDateTime As Long
End Type
Private Type WIN32_FIND_DATA
 dwFileAttributes As Long
 ftCreationTime As FILETIME
 ftLastAccessTime As FILETIME
 ftLastWriteTime As FILETIME
 nFileSizeHigh As Long
 nFileSizeLow As Long
 dwReserved0 As Long
 dwReserved1 As Long
 cFileName As String * MAX_PATH
 cAlternate As String * 14
End Type
Private FSO As Object

Sub SpeedTestCheckCDrive()
 Dim DirArray() As String, FSOArray() As String
 Dim FSArray() As String, APIArray() As String
 Dim i As Long, SearchPath As String
 Dim Timer1 As Double, Timer2 As Double, Timer3 As Double, Timer4 As Double
 
 SearchPath = "C:\"
 ReDim FSOArray(0)
 ReDim DirArray(1, 0)
 ReDim FSArray(0)
 ReDim APIArray(0)
 
 Timer1 = Timer
 Set FSO = CreateObject("scripting.filesystemobject")
 ReturnAllFilesUsingFSO SearchPath, FSOArray
 Set FSO = Nothing
 Timer1 = Timer - Timer1
DoEvents
 Timer2 = Timer
 ReturnAllFilesUsingDir SearchPath, DirArray
 Timer2 = Timer - Timer2
DoEvents
 Timer3 = Timer
 ReturnAllFilesUsingFileSearch SearchPath, FSArray
 Timer3 = Timer - Timer3
DoEvents
 Timer4 = Timer
 ReturnAllFilesUsingAPI SearchPath, APIArray
 Timer4 = Timer - Timer4
 
 Debug.Print Join(Array( _
  "FSO took " & Timer1 & " seconds, " & UBound(FSOArray) + 1 & " files found", _
  "DIR took " & Timer2 & " seconds, " & UBound(DirArray, 2) + 1 & " files found", _
  "FileSearch took " & Timer3 & " seconds, " & UBound(FSArray) + 1 & " files found", _
  "APIs took " & Timer4 & " seconds, " & UBound(APIArray) + 1 & " files found"), vbCrLf)
End Sub

Function ReturnAllFilesUsingDir(ByVal vPath As String, ByRef vsArray() _
  As String, Optional IncludeSubfolders As Boolean = True) As Boolean
 'You must send this a string array, ReDim'med to (1,0)
 ' (0,x) = path of file
 ' (1,x) = file name
 Dim TempStr As String, vDirs() As String, Cnt As Long, dirCnt As Long
 dirCnt = 0
 If Len(vsArray(0, 0)) = 0 Then
  Cnt = 0
 Else
  Cnt = UBound(vsArray, 2) + 1
 End If
 If Right(vPath, 1) <> "\" Then vPath = vPath & "\"
 
 If IncludeSubfolders Then
  On Error GoTo BadDir
  TempStr = Dir(vPath, 31)
  Do Until Len(TempStr) = 0
   If Asc(TempStr) <> 46 Then
    If GetAttr(vPath & TempStr) And vbDirectory Then
     ReDim Preserve vDirs(dirCnt)
     vDirs(dirCnt) = TempStr
     dirCnt = dirCnt + 1
     DoEvents
    End If
BadDirGo:
   End If
   TempStr = Dir
SkipDir:
  Loop
 End If
 
 On Error GoTo BadFile
 TempStr = Dir(vPath, 15)
 Do Until Len(TempStr) = 0
  ReDim Preserve vsArray(1, Cnt)
  vsArray(0, Cnt) = vPath
  vsArray(1, Cnt) = TempStr
  Cnt = Cnt + 1
  TempStr = Dir
  DoEvents
 Loop
BadFileGo:
 On Error GoTo 0
 If dirCnt > 0 Then
  For dirCnt = 0 To UBound(vDirs)
   If Len(Dir(vPath & vDirs(dirCnt))) = 0 Then
    GetFilesWithDir vPath & vDirs(dirCnt), vsArray
   End If
  Next
 End If
 Exit Function
BadDir:
 If TempStr = "pagefile.sys" Or TempStr = "???" Then
  Debug.Print "DIR: Skipping: " & vPath & TempStr
  Resume BadDirGo
 ElseIf Err.Number = 52 Then
  Debug.Print "No read dir rights: " & vPath & TempStr
  Resume SkipDir
 End If
 Debug.Print "Error with DIR Dir: " & Err.Number & " - " & Err.Description
 Exit Function
BadFile:
 If Err.Number = 52 Then
  Debug.Print "No read file rights: " & vPath & TempStr
 Else
  Debug.Print "Error with DIR File: " & Err.Number & " - " & Err.Description
 End If
 Resume BadFileGo
End Function

Function ReturnAllFilesUsingFSO(ByVal vPath As String, _
  ByRef vsArray() As String) As Boolean
 Dim f As Object, fld As Object, Cnt As Long
 Set fld = FSO.GetFolder(vPath)
 If Len(vsArray(0)) = 0 Then
  Cnt = 0
 Else
  Cnt = UBound(vsArray) + 1
 End If
 On Error GoTo UhOhs
 For Each f In fld.Files
  ReDim Preserve vsArray(Cnt)
  vsArray(Cnt) = f.Path
  Cnt = Cnt + 1
  DoEvents
 Next
 For Each f In fld.SubFolders
  ReturnAllFilesUsingFSO f.Path, vsArray
 Next
LaterGater:
 Set f = Nothing
 Set fld = Nothing
 Exit Function
UhOhs:
 If Err.Number = 70 Then
  Debug.Print "FSO Permission denied: " & vPath
 Else
  Debug.Print "Error with FSO: " & Err.Number & " - " & Err.Description
 End If
 Resume LaterGater
End Function

Function ReturnAllFilesUsingFileSearch(ByVal vPath As String, ByRef vsArray() _
  As String) As Long
 Dim i As Long, Cnt As Long
 With Application.FileSearch
  .NewSearch
  .SearchSubFolders = True
  .LookIn = vPath
  .FileType = msoFileTypeAllFiles
  If .Execute > 0 Then
   Cnt = 0
   On Error GoTo PermissionDenied
   ReDim Preserve vsArray(.FoundFiles.Count - 1)
   For i = 1 To .FoundFiles.Count
    vsArray(Cnt) = .FoundFiles(i)
    Cnt = Cnt + 1
SkipIt:
    DoEvents
   Next
  End If
 End With
 Exit Function
PermissionDenied:
 ReDim Preserve vsArray(UBound(vsArray) - 1)
 Resume SkipIt
End Function

Function ReturnAllFilesUsingAPI(vPath As String, ByRef vsArray() As String) As Boolean
 Dim FileName As String
 Dim DirName As String
 Dim dirNames() As String
 Dim nDir As Long
 Dim i As Long
 Dim hSearch As Long
 Dim WFD As WIN32_FIND_DATA
 Dim Cont As Long
 Dim Cnt As Long
 If Len(vsArray(0)) = 0 Then
  Cnt = 0
 Else
  Cnt = UBound(vsArray) + 1
 End If
 If Right(vPath, 1) <> "\" Then vPath = vPath & "\"
 nDir = 0
 ReDim dirNames(nDir)
 Cont = True
 hSearch = FindFirstFile(vPath & "*", WFD)
 If hSearch <> INVALID_HANDLE_VALUE Then
  Do While Cont
   DirName = StripNulls(WFD.cFileName)
   If (DirName <> ".") And (DirName <> "..") Then
    If GetFileAttributes(vPath & DirName) And FILE_ATTRIBUTE_DIRECTORY Then
     ReDim Preserve dirNames(nDir)
     dirNames(nDir) = DirName
     nDir = nDir + 1
     DoEvents
    End If
   End If
   Cont = FindNextFile(hSearch, WFD)
  Loop
  Cont = FindClose(hSearch)
 End If
 hSearch = FindFirstFile(vPath & "*", WFD)
 Cont = True
 If hSearch <> INVALID_HANDLE_VALUE Then
  While Cont
   FileName = StripNulls(WFD.cFileName)
    If (FileName <> ".") And (FileName <> "..") And ((GetFileAttributes(vPath _
      & FileName) And FILE_ATTRIBUTE_DIRECTORY) <> FILE_ATTRIBUTE_DIRECTORY) Then
     ReDim Preserve vsArray(Cnt)
     vsArray(Cnt) = vPath & FileName
     Cnt = Cnt + 1
    End If
   Cont = FindNextFile(hSearch, WFD)
  Wend
  Cont = FindClose(hSearch)
 End If
 If nDir > 0 Then
  For i = 0 To nDir - 1
   ReturnAllFilesUsingAPI vPath & dirNames(i) & "\", vsArray
  Next i
 End If
End Function

Private Function StripNulls(OriginalStr As String) As String
 If (InStr(OriginalStr, Chr(0)) > 0) Then
  OriginalStr = Left(OriginalStr, InStr(OriginalStr, Chr(0)) - 1)
 End If
 StripNulls = OriginalStr
End Function

Loop through all files within a directory

Another thing I see a lot is where someone wants to loop through a directory (and/or subfolders). There are a number of ways to do this, such as VB's Dir() method, FileSystemObject, FindFirstFile/FindNextFile APIs, even Application.FileSearch (up through excel 2003, I believe). I have done a few speed tests for various threads, and usually find Dir() to be the quickest (usually true for local disks; network shares seem to vary). Dir is also the one I go with the most, as it doesn't require and early/late binding for FSO, and needs no API declare statements.

Note that if you're working in VBScript, you will have to use FileSystemObject, as Dir() doesn't exist in VBS and APIs are more trouble than they're worth if you want to use them (you'd have to create a container class in vb to use them in vbs).

Here is an example of looping through all the files within a specific directory; my calling subroutine just sends a message box with the number of files contained, but it can obviously do much more. I'm also including a simple routine called DesktopAddress, should anyone ever want to know the desktop's location via code (I use this is many of my distributed projects at work, actually). Run the LoopThroughAllFilesInDirectory to return a filecount of files on your desktop, and change as needed!

Sub LoopThroughAllFilesInDirectory()
 Dim vFiles() As String, i As Long
 ReDim vFiles(1, 0)
 GetFilesWithDir DesktopAddress, vFiles 'all files desktop + below
 MsgBox "You have " & CStr(UBound(vFiles, 2) + 1) & " files on your desktop"
End Sub
Function DesktopAddress() As String
 Dim vShell As Object, vDesktop As String
 Set vShell = CreateObject("WScript.Shell")
 vDesktop = vShell.SpecialFolders("Desktop")
 If Right(vDesktop, 1) <> "\" Then vDesktop = vDesktop & "\"
 DesktopAddress = vDesktop
 Set vShell = Nothing
End Function

Function GetFilesWithDir(ByVal vPath As String, ByRef vsArray() _
  As String, Optional IncludeSubfolders As Boolean = True) As Boolean
 'You must send this a string array, ReDim'med to (1,0)
 ' (0,x) = path of file
 ' (1,x) = file name
 Dim TempStr As String, vDirs() As String, Cnt As Long, dirCnt As Long
 dirCnt = 0
 If Len(vsArray(0, 0)) = 0 Then
  Cnt = 0
 Else
  Cnt = UBound(vsArray, 2) + 1
 End If
 If Right(vPath, 1) <> "\" Then vPath = vPath & "\"
 
 If IncludeSubfolders Then
  On Error GoTo BadDir
  TempStr = Dir(vPath, 31)
  Do Until Len(TempStr) = 0
   If Asc(TempStr) <> 46 Then
    If GetAttr(vPath & TempStr) And vbDirectory Then
     ReDim Preserve vDirs(dirCnt)
     vDirs(dirCnt) = TempStr
     dirCnt = dirCnt + 1
    End If
BadDirGo:
   End If
   TempStr = Dir
SkipDir:
  Loop
 End If
 
 On Error GoTo BadFile
 TempStr = Dir(vPath, 15)
 Do Until Len(TempStr) = 0
  ReDim Preserve vsArray(1, Cnt)
  vsArray(0, Cnt) = vPath
  vsArray(1, Cnt) = TempStr
  Cnt = Cnt + 1
  TempStr = Dir
 Loop
BadFileGo:
 On Error GoTo 0
 If dirCnt > 0 Then
  For dirCnt = 0 To UBound(vDirs)
   If Len(Dir(vPath & vDirs(dirCnt))) = 0 Then
    GetFilesWithDir vPath & vDirs(dirCnt), vsArray
   End If
  Next
 End If
 Exit Function
BadDir:
 If TempStr = "pagefile.sys" Or TempStr = "???" Then
  Debug.Print "DIR: Skipping: " & vPath & TempStr
  Resume BadDirGo
 ElseIf Err.Number = 52 Then
  Debug.Print "No read dir rights: " & vPath & TempStr
  Resume SkipDir
 End If
 Debug.Print "Error with DIR Dir: " & Err.Number & " - " & Err.Description
 Exit Function
BadFile:
 If Err.Number = 52 Then
  Debug.Print "No read file rights: " & vPath & TempStr
 Else
  Debug.Print "Error with DIR File: " & Err.Number & " - " & Err.Description
 End If
 Resume BadFileGo
End Function

VBA/VB6/VBS word replace - Regular expressions

Did you ever wish you could replace entire words within a string? Maybe you're changing names within a document and want to change "Mark" to "Horace", but don't want to have "market" turn into "Horaceet". Or maybe you want to insert a word, but only in relation to another specific word? Then use regular expressions!

Make sure to escape any regexp special characters, and use the \b word boundaries around the 'Find what' portion. Occasionally I'll even use my "rxPatt = ..." line in other routines when I need to escape a search string for regexp. Works well, though I find myself using this less and less nowadays. Unless you have long strings within cells, it isn't that useful for Excel unfortunately. I have found a couple uses here and there, but not too many.

Anyways.. on to the code!

Function RegExWordReplace(ByVal rxFull As String, ByVal rxWhat As String, ByVal _
  rxRepl As String, Optional ByVal rxIgnoreCase As Boolean = True) As String
 'rxFull = Full string that you will be doing your find/replace within
 'rxWhat = What to find within the full string
 'rxRepl = What to replace the found string with
 'rxIgnoreCase = You can make the search case-sensitive by specifying this = false
 Dim RegEx As Object, rxPatt As String
 Set RegEx = CreateObject("vbscript.regexp")
 rxPatt = Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace( _
  Replace(Replace(Replace(Replace(rxWhat, "\", "\\"), "^", "\^"), "$", "\$"), "*", _
  "\*"), "+", "\+"), "?", "\?"), ".", "\."), "(", "\("), ")", "\)"), "|", "\|"), _
  "{", "\{"), "}", "\}"), ",", "\,")
 With RegEx
  .Pattern = "\b" & rxPatt & "\b"
  .Global = True
  .IgnoreCase = rxIgnoreCase
  .MultiLine = True
 End With
 If RegEx.Test(rxFull) Then rxFull = RegEx.Replace(rxFull, rxRepl)
 RegExWordReplace = rxFull
 Set RegEx = Nothing
End Function

And to test it:

Sub WordReplaceExample()
 Dim OrigStr As String, NewStr As String
 OrigStr = "Our normal products were found to have no side effects."
 NewStr = RegExWordReplace(OrigStr, "no", "no adverse")
 MsgBox OrigStr & vbCrLf & vbCrLf & NewStr
End Sub

Splitting a worksheet based on a column's value

One question I come across a lot is when someone has a lot of data on a single worksheet, and wants to split it out to multiple worksheets based on the value of a column. For example, if someone had the following birthday data on a worksheet, and wanted to have a sheet for each month. Assume this sample data:

SHEET NAME: Birthdays
Name    Month      Day
Emmy    August     27
Bill    July       3
Andy    November   24
Bob     July       27
Dana    June       24

And after running a macro:

SHEET NAME: August
Name    Month      Day
Emmy    August     27

SHEET NAME: July
Name    Month      Day
Bill    July       3
Bob     July       27

SHEET NAME: November
Name    Month      Day
Andy    November   24

SHEET NAME: June
Name    Month      Day
Dana    June       24

That is a simplistic example, but I see something like that frequently. The following code will do that for you, just set the column to use for the splitting-data and run.

Option Explicit
Sub SplitIntoMultipleSheetsBasedOnColumn()
 Dim TheColumn As Range, ValRG As Range
 Dim UniqVals() As Variant, AllVals() As Variant
 Dim FirstDataRow As Long, i As Long, Cnt As Long
 
 'Unique values in the column specified by TheColumn are given their own worksheet,
 ' and their entire row is copied to that worksheet
 Set TheColumn = Columns("G") 'must be a single column
 FirstDataRow = 2 'so that the header row(s) aren't turned into a sheet
 
 Set ValRG = Intersect(TheColumn, TheColumn.Worksheet.UsedRange, _
  TheColumn.Worksheet.Rows(FirstDataRow & ":" & TheColumn.Worksheet.Rows.Count))
 If ValRG Is Nothing Then
  MsgBox "No data found. Exiting."
  Exit Sub
 End If
 ReDim UniqVals(0)
 Cnt = 0
 AllVals = ValRG.Value
 For i = 1 To UBound(AllVals, 1)
  If Not InArray(UniqVals, AllVals(i, 1)) Then
   ReDim Preserve UniqVals(Cnt)
   UniqVals(Cnt) = AllVals(i, 1)
   Cnt = Cnt + 1
  End If
 Next 'i
 
 Application.ScreenUpdating = False
 For i = LBound(UniqVals) To UBound(UniqVals)
  Set ValRG = FoundRange(TheColumn, UniqVals(i))
  With Sheets.Add(After:=Sheets(Sheets.Count))
   On Error Resume Next
   .Name = ValidSheetName(UniqVals(i))
   On Error GoTo 0
   If FirstDataRow > 1 Then TheColumn.Worksheet.Range(TheColumn.Cells(1), _
    TheColumn.Cells(FirstDataRow - 1)).EntireRow.Copy .Range("A1")
   ValRG.EntireRow.Copy .Range("A" & FirstDataRow)
  End With
 Next 'i
 Application.ScreenUpdating = True
End Sub
Private Function ValidSheetName(ByVal DesiredSheetName As String) As String
 On Error Resume Next
 ValidSheetName = Left(Replace(Replace(Replace(Replace(Replace(Replace(Replace( _
  DesiredSheetName, ":", ""), "\", ""), "/", ""), "?", ""), "*", ""), "[", ""), _
  "]", ""), 31)
End Function
Public Function InArray(ByRef vArray(), ByVal vValue) As Boolean
 Dim i As Long
 For i = LBound(vArray) To UBound(vArray)
  If vArray(i) = vValue Then
   InArray = True
   Exit Function
  End If
 Next 'i
 InArray = False
End Function
Function FoundRange(ByVal vRG As Range, ByVal vVal) As Range
 Dim FND As Range, FND1 As Range
 Set FND = vRG.Find(vVal, LookIn:=xlValues, LookAt:=xlWhole)
 If Not FND Is Nothing Then
  Set FoundRange = FND
  Set FND1 = FND
  Set FND = vRG.FindNext(FND)
  Do Until FND.Address = FND1.Address
   Set FoundRange = Union(FoundRange, FND)
   Set FND = vRG.FindNext(FND)
  Loop
 End If
End Function

Note that you don't need to sort your sheet first, though it will make things run a bit smoother. I originally had the code go through an array containing the sheet data, but a lot of the format was being lost. This way takes slightly longer but everything stays to the new sheets. I use this for my job, and I'm sure other people can use it for theirs as well.

Working with the recycling bin

Now, if you've ever tried to interact with the recycling bin in VBA (or VB6) you probably know it can get a bit complicated at times. pIDLs, IShellFolder interfaces, lots of fun stuff. Did you know you can do some basic tasks without using any of that? Some examples:

Send a file to the recycling bin rather than just deleting it

Option Explicit
Private Type SHFILEOPTSTRUCT
 hWnd As Long
 wFunc As Long
 pFrom As String
 pTo As String
 fFlags As Integer
 fAnyOperationsAborted As Long
 hNameMappings As Long
 lpszProgressTitle As Long
End Type
Private Declare Function SHFileOperation Lib "shell32.dll" Alias "SHFileOperationA" ( _
  lpFileOp As SHFILEOPTSTRUCT) As Long
Private Const FO_DELETE = &H3
Private Const FOF_ALLOWUNDO = &H40
Public Sub DeleteFileToRecycleBin(vFilename As String)
 Dim vFileOp As SHFILEOPTSTRUCT
 With vFileOp
  .wFunc = FO_DELETE
  .pFrom = vFilename
  .fFlags = FOF_ALLOWUNDO
 End With
 SHFileOperation vFileOp
End Sub

Empty the recycling bin

Option Explicit
Private Declare Function SHEmptyRecycleBin Lib "shell32.dll" Alias "SHEmptyRecycleBinA" _
 (ByVal hWnd As Integer, ByVal pszRootPath As String, ByVal dwFlags As Integer) As Integer
Private Declare Function SHUpdateRecycleBinIcon Lib "shell32.dll" () As Long
Private Const SHERB_NOCONFIRMATION = &H1
Private Const SHERB_NOPROGRESSUI = &H2
Private Const SHERB_NOSOUND = &H4
Private Sub EmptyRecycleBin()
 SHEmptyRecycleBin 0, vbNullString, SHERB_NOCONFIRMATION
 SHUpdateRecycleBinIcon
End Sub

Restore from the recycling bin

Option Explicit
Sub RestoreFromRecyclingBin()
 Dim vShell As Object, vRecycler As Object
 Const ssfBITBUCKET As Long = 10 'the BitBucket is the recycling bin
 Set vShell = CreateObject("Shell.Application")
 Set vRecycler = vShell.NameSpace(ssfBITBUCKET)
 RestoreRecycledItems vRecycler
 Set vRecycler = Nothing
 Set vShell = Nothing
End Sub
Private Sub RestoreRecycledItems(vObj As Object)
 Dim vItem As Object
 For Each vItem In vObj.Items
  'Remove this next line if you don't want to iterate through a deleted folder
  If vItem.IsFolder Then Call RestoreRecycledItems(vItem)
   
  'You can use   vObj.GetDetailsOf(vItem, x)   where x is a number from 0 to 4, to return
  '   string information about the recycled item. Definition of x:
  ' 0 = Filename
  ' 1 = Path
  ' 2 = Deleted Date/Time
  ' 3 = File type (long name, not extension)
  ' 4 = Size (in KB, or whatever your windows explorer uses as default size)
  
  'Here I will check the deleted date, and if it was deleted today, restore it
  ' Since   .GetDetailsOf(vItem ,2)   returns deleted date and time, I cut off the time
  If Int(CDate(vObj.GetDetailsOf(vItem, 2))) = Date Then
   'use the folderitem's InvokeVerb method to restore it
   Call vItem.InvokeVerb("R&estore")
  End If
 Next
 Set vItem = Nothing
 Set vObj = Nothing
End Sub

Fun, huh?

Wootoffs

Do you ever Woot? I do. If you do too, then you probably know what a Wootoff is. Ever wish you could easily know what item is up and how much is left (and be more ready when their bags of crap are available, since you have literally only seconds to buy one). Well why not use our favorite tool (Excel)! I made this for a wootoff last week Heres how you can do it:

1. Download wootie.xla, and save it to your addins directory, usually:
   C:\Documents and Settings\your-username\Application Data\Microsoft\AddIns\
2. Open Excel, and with a workbook open go to Tools then AddIns. If you do not see Wootie listed, then click Browse and select wootie.xla
3. After your "Help" menu there will now be a Wootie menu. Assuming there is a wootoff, go to Start Wootoff, and you should be all set!

• As with all my add-ins, I kept it unlocked and the source code is fully viewable/editable.

It helped me out this past wootoff, hopefully it'll help you out as well. Beware though, if you plan on actually using Excel during this time, you may want to open a new instance of Excel for Wootie so it doesn't interfere. I coded it to hide the excel application while the IE statusbar window is up, but don't worry if you forgot and think your open files are gone; they'll be back when the IE window closes. I went with IE instead of a userform so that I could easily open a new window when a bag of crap comes up (less load time if it is already open). And for the more advanced users, you can always code yourself a BOC-sniping subroutine for when they're available (the other benefit of IE--easy automation from vba)

VBA will be back for Mac Office!

Ok, those of you that know me know that I'm not a huge Mac/Apple fan. I'm not really much against them, though I don't like the 'anti-pc' tone of their commercials versus a traditional 'pro-mac' commercial. Regardless, being a huge Excel and VBA fan, I felt bad for the many mac users that bought Office 2008 only to find out VBA was gone. Now I know the reasons behind it, so I'm not going to whinge about it, but it still sucked. That move alone would have prompted me to leave my mac in the dust (if I had one), despite it being a decision on Microsoft's part rather than Apple's.

So I was very happy to read today that VBA will be back in the next version of Mac Office! The press release is really about the release of SP1, but said MS will be bringing VBA back at a yet-unspecified future date. Score one for the good guys!

Go VBA!

Pidgin plugins, a how-to and rant (part 1)

I'm finding out what a joy it is to write a plugin for pidgin. For those unaware of what that is, it is an opensource instant messaging program that lets you use multiple IM protocols (AIM, YahooIM, MSN Messenger, etc). If you've heard of something called Trillion, it is similar to that. It used to be called Gaim.

Anyways.. here is my problem. I have my power management set up to turn off the monitor after 10 minutes of activity. When I'm home and not using the computer, and someone sends me an IM, I don't usually see it until I use the computer again (or if I get an email, but I'll explain that later). I don't like that. I know I could turn it off, but I'm not gonna do that. So I need to figure out a workaround.

I have my email checking program set up to flash the "scroll lock" on the keyboard when I get an email so the screen saver / power management turns off, like someone is pressing the key every second. So last night I thought, why can't I set up a plugin for pidgin to do something similar? I've never written anything for it before, but since the capability is there and I can stumble through enough c to write the code for it I thought it made sense.

Then I dove into it. Went on the pidgin developer site, looked at the plugin code samples, and realized it was going to be tougher than I thought. The API wasn't very well documented, and the outdated examples (when not " This page is a placeholder pending the completion of this document." -July2007) weren't much help. I managed to write the code for it using the samples there and some code on some guy's blog, then came time to compile it.

If you're a developer of any kind and have a couple free minutes, take a look at the pidgin developer site and see if the compilation instructions make much sense to you. They aren't totally incoherent, but far from straight forward.

• Install cygwin to create a linux-like build environment. The setup of that program was not the friendliest I've used, but I got through it as well as adding the non-default (but necessary for my case) cygwin packages (make, patch, monotone, unzip, wget)
• Running the windows pidgin build environment fetcher using my new cygwin shell to get the needed dependencies (another time-consuming process in itself since it was my first use of it). I especially loved the yes/no question that only allowed "[p/n]" as answers.
  
• A few compile issues that were no fault of mine, but still had to be researched (and researched) online to figure out how to get it to compile. Finally got down to a single compile error (dealing with ld.exe and -lpurple) and I couldn't figure out how to fix it.
  Hours later and I was no further along.
  

After a bit of time setting up a build environment and then figuring out how cygwin worked, I had made headway. Unfortunately that error ("ld.exe: cannot find -lpurple") kept me dead in the water, and I had to get some sleep. I'll try more tonight after work I suppose.

My firefox extensions

Since that last post mentioned two extensions I use, I thought I'd throw this out there.

Here are the extensions I use on this computer, my others have a slightly different setup but pretty much the same:

• Adblock Plus -- I don't block the adsense ones, but I do block some of the more annoying javascript ones on some other pages, that only get in my way and/or make some sort of sound.
• DOM Inspector -- I think this one is basically included with FireFox
• Download Statusbar -- I found this one a few weeks ago, loving it. The downloads window always seemed to annoy me before, this seems like a happy medium.
• LinkVisitor -- I don't really use this one much anymore (still enabled), I was using this while trying to clean up my history file (lots of "invisible" ad sites in there that bloated my history.dat file, making FF freeze anytime I happened to click the History commandbar). I mostly use this for the "mark all links as read" (which also adds them to the history)
• Gmail Notifier -- So simple but so useful
• Google Reader Watcher -- Same

What extensions do you use and/or love? I used to use FasterFox until I realized that it actually seems to slow FF down. Anyone know of an extension that just times the page load, and nothing else?

Google AdSense

Ok, so I decided I'd add Google AdSense here. If anyone thinks I should remove the ads (if people start actually reading this), just let me know. If I get $0.02/year, I'll be happy. Who knows, maybe you'll find something you want to buy.

Rather than have a small post here, I thought I'd share my love of Google as well. It has been my homepage for a while, and now that I've got my iGoogle customized with my Gmail, Google reader, Google weather, and numerous direct news feeds and what not I only need to really check the one page for any of my 'essentials'. Plus there is their Blogger and Picasa tools, Google Docs, Google news, and of course their search.

Add in the Firefox extensions for Google Reader and Gmail, and you're good to go! I should buy some Google stock.

Mario Kart Wii

Great game! If you've ever played a mario kart game before, you'll love this. It keeps most of the same gameplay from previous versions (less some character specific items, and unfortunately no 2-player grand prix), but adds internet play!

I tried the wheel for a while and got pretty good with it, but honestly I prefer using the wiimote with a nunchuck. The little white or gold wheel next to my name online does nothing for me, so I see no benefit to using it.

It does take quite a few hours to unlock everything in it, and I don't even have it all just yet (all but 2 characters and 1 car -- out of the 16 unlockable tracks, 16 unlockable characters, and 18 unlockable vehicles {9 karts, 9 bikes}).

Overall it is immensely fun. I just need to get more people I know to buy it...


Got the game? Send me your license number!

New Computer

Well, I got a new computer a couple weeks ago and have been slowly integrating it into my normal usage. It didn't help that the parts came over the course of a week (most in the first 2 days, save some necessary sata cables that rendered the rest of it useless), and that my pretty new monitor (hp w2207) worked well with my old pc, delaying my motivation/installation. For those that are curious/bored, heres the specs on my new computer:

• CPU: Intel E8400 -- 3.0ghz core 2 duo, fast goodness
  
• Motherboard: ASUS nForce 750i -- Does everything I need and much more (everything I may need someday?)
• RAM: G.Skill 4GB -- Nothing too special here, 4gb of DDR2 800 PC2 6400. Works very well though and no issues installing it at all
• Video Card: eVGA GeForce 8800GT -- Sweeeeeeeeeet card. I'm immensely impressed at what this thing can do. PCIx 2.0x16, 512mb, 256bit, GDDR3, HDCP, SLI; this should keep my graphics near-high-end for years
• Monitor: HP w2207 -- Great monitor. Get one. Actually, why not get two? 22" widescreen LCD, 1680x1050, 1000:1, DVI or VGA input, even has USB ports and can be easily rotated to be in Portrait mode instead of the usual landscape mode (VERY useful for long spreadsheets and web pages)
• Hard Drive: WD Caviar 500gb sata 7200/16mb --Just a big hard drive.. I had read a bunch of good reviews, so I got one. Actually I bought this last Friday and should get it tomorrow hopefully, currently have an old 120gb drive in the machine right now (which will stay, my OS is on it)
• DVD/CD drive: Samsung DVD burner -- Just a fast, robust, sata dvd burner. Lots of good features on it, though I've only used it so far for reading cds/dvds and haven't burned anything yet. Soon enough, I'm sure, as I can't wait to try the dual layer. Hoping the lightscribe isn't just marketing hype
• Case/PSU: CoolerMaster RC-690-KKA1-GP -- Big case (bigger than I was expecting :/), lots of great tool-less features and lots of room for fans. Included a few fans to begin with, as well as a 550w PSU, plus external ports. And it is black. I guess the only thing I don't like is the neon blue glowing in the front, but certainly not enough to want a new one. Way too many positives outweight it.

So yeah, that is it. Installed XP x64 on it, Firefox, Visual Studio 2008, Office 2007 ultimate (woo!), and Guild Wars. Haven't tried that other than just a quick check to see how it looked, which was much better than my old pc. The release of Mario Kart Wii kinda curbed my enthusiasm for the new computer, it'll return soon enough I'm sure.

Oh, and I got a USB wi-fi adapter for it too, in case I decide not to anchor it near my router. Much better than the one I had anyways for my laptop, so it was money well spent.

Overall, the computer was a little more than I had planned to spend, but if nothing else I can thank the $600 economic stimulus refund I got, and simply write the monitor off as a personal 30th birthday present.

Firefox history.dat file

Mork sucks.