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.