LHSP‡ active window titledisplay title of current windowtestýøÿÿ ' declare three Windows functions Declare Function GetForegroundWindow& Lib "user32" () Declare Function GetWindowTextLengthA& Lib "user32" _ (ByVal hwnd&) Declare Sub GetWindowTextA Lib "user32" _ (ByVal hwnd&, ByVal lpsz$, ByVal cbMax&) ' ' use Windows functions to obtain a string with the ' title of the current window. The string is returned ' as the value of the ActiveWindowTitle function. Function ActiveWindowTitle$() ActiveWindow = GetForegroundWindow() TitleLen = GetWindowTextLengthA(ActiveWindow) Title$ = Space$(TitleLen) GetWindowTextA ActiveWindow,Title$,TitleLen+1 ActiveWindowTitle$ = Title$ End Function ' Use the window title – in this case, display it. ' More commonly it would be compared. Sub Main MsgBox ActiveWindowTitle$ End Sub choose formatdialog command for formattingtestýøÿÿ‘Sub Main Begin Dialog UserDialog 400,203 ' %GRID:10,7,1,1 TextBox 30,14,330,63,.TextBox1,1 OptionGroup .Group1 OptionButton 40,91,90,14,"bold",.OptionButton1 OptionButton 40,119,90,14,"underline",.OptionButton2 OptionButton 40,147,90,14,"italics",.OptionButton3 OKButton 80,175,90,21 CancelButton 230,175,90,21 End Dialog Dim dlg As UserDialog If Dialog(dlg) = -1 Then Select Case dlg.Group1 Case 0 ' bold s="^b" Case 1 ' underline s="^u" Case 2 ' italics s="^i" End Select ' Wait .5 ' let focus return SendKeys s SendKeys dlg.TextBox1 SendKeys s Else End If End Sub control panel appletshell commands using listtestýøÿÿ¨Sub Main ' There are many of these applets. ' Some have different values in different versions of Windows. ' This sample is based on Windows-XP Professional ' The second argument to the Shell command, "vbMaximizedFocus", causes ' windows to open. If not present, then some of these Control ' Panel applets open minimized. Shell("control " & Mid(ListVar1,1,InStr(ListVar1,"\")-1),vbMaximizedFocus) End Sub control panel audioopen the audio applettestýøÿ1Sub Main Shell "control mmsys.cpl,,2" End Sub control panel screen saveropen the screen saver applettestýøÿ0Sub Main Shell "control desk.cpl,,1" End Sub current mouse position+get the current mouse position in clipboardtestýøÿÿ!Option Explicit Type RECT Left As Long Top As Long Right As Long Bottom As Long End Type Type POINTAPI x As Long y As Long End Type ' declare Win32 API functions Declare Function GetCursorPos Lib "user32" _ Alias "GetCursorPos" (lpPoint As POINTAPI) As Long Declare Function GetWindowRect Lib "user32" _ Alias "GetWindowRect" (ByVal hwnd As Long, _ lpRect As RECT) As Long Declare Function GetForegroundWindow& Lib "user32" () Function GetWinCurPos(hwnd As Long) As POINTAPI Dim pt As POINTAPI Dim wRect As RECT Dim result As POINTAPI GetCursorPos pt GetWindowRect hwnd, wRect result.x = pt.x - wRect.Left result.y = pt.y - wRect.Top GetWinCurPos = result End Function Sub Main Dim hwnd As Long Dim result As POINTAPI Dim clip As String hwnd = GetForegroundWindow result = GetWinCurPos(hwnd) clip = "SetMousePosition 1," & result.x & _ "," & result.y clip = clip & Chr(13) & Chr(10) & _ "ButtonClick" & Chr(13) & Chr(10) ' Clipboard clip ' MsgBox clip, 64, "Mouse Test" End Sub $document name_of_document_templateopen a Word templatetestýøÿWINWORDMicrosoft Word for WindowsMicrosoft CorporationÿF'#Reference {00020905-0000-0000-C000-000000000046}#8.3#0#D:\Program Files\Microsoft Office\OFFICE11\MSWORD.OLB#Microsoft Word 11.0 Object Library Sub Main ' ' Start with the default User Template directory for Word Filename$ = Options.DefaultFilePath(wdUserTemplatesPath) ' ' append the "\", the file name, and the ".dot" suffix Filename$ = Filename$ & "\" & ListVar1 & ".dot" ' ' prepare for the case where the template does not exist On Error GoTo NoTemplate ' ' open a new instance of the template using the Word ' VBA statement for opening a document template. ' Note the continuation of the statement (“_”) Documents.Add Template:=Filename$, NewTemplate:=False, _ DocumentType:=0 Exit Sub ' NoTemplate: ' Come here if no template exists ErrMess$ = "Template not found: " & ListVar1 MsgBox ErrMess$ End Sub email subjectstestýøÿÿ/Sub Main Dim myOlApp As Object Dim intMsgCount As Integer, intMyFoldersCount As Integer Dim myFolder As Variant Dim x As Integer Set myOlApp = CreateObject("Outlook.Application") Set myNameSpace = myOlApp.GetNamespace("MAPI") Set myFolder= myNameSpace.GetDefaultFolder(6) ' intMsgCount = myFolder.Items.Count ' Loop through each message and display the ' unread messages with MsgBox For x = 1 To intMsgCount myUnread = myFolder.Items(x).Unread If myUnread = True Then MsgBox myFolder.Items(x) End If Next x End Sub insert  insertableinsert a block of texttestýøÿWINWORDMicrosoft Word for WindowsMicrosoft Corporationÿ&'#Reference {00020905-0000-0000-C000-000000000046}#8.3#0#D:\Program Files\Microsoft Office\OFFICE11\MSWORD.OLB#Microsoft Word 11.0 Object Library Sub Main ' Create the filename. ' Start with the default file path from Word. If you wish a ' different folder for these files, replace the following ' statement with one of the form ' Filename$ = "your folder name" Filename$ = Options.DefaultFilePath(wdDocumentsPath) ' ' Append a trailing backslash, then the insertable file name, ' then ".doc" to complete the file name. Filename$ = Filename$ & "\" & ListVar1 & ".doc" ' ' The following three lines are from VBA and ' do the file insertion. Selection.InsertFile FileName:= Filename$, Range:="", _ ConfirmConversions:=False, Link:=False, _ Attachment:=False End Sub large dictation box4large type version of Show Dictation Box (Release 8)testýøÿÿÇ ' code courtesy of Polar Engineering; Valerie Matthews of ScanSoft; and Larry Allen of Softnet Systems, Inc. Option Explicit Const FONT=18 ' Approximate font size - change as required Const LOGPIXELSY = 90 Const WM_SETFONT = &H30 Declare Function CreateFontA Lib "gdi32" ( _ ByVal nHeight As Long, _ ByVal nWidth As Long, _ ByVal nEscapement As Long, _ ByVal nOrientation As Long, _ ByVal fnWeight As Long, _ ByVal fdwItalic As Long, _ ByVal fdwUnderline As Long, _ ByVal fdwStrikeOut As Long, _ ByVal fdwCharSet As Long, _ ByVal fdwOutputPrecision As Long, _ ByVal fdwClipPrecision As Long, _ ByVal fdwQuality As Long, _ ByVal fdwPitchAndFamily As Long, _ ByVal lpszFace As String _ ) As Long Declare Function DeleteObject Lib "gdi32" ( _ ByVal hObject As Long _ ) As Long Declare Function GetDeviceCaps Lib "gdi32" ( _ ByVal hDC As Long, _ ByVal nIndex As Long _ ) As Long Declare Function GetDlgItem Lib "user32" ( _ ByVal hDlg As Long, _ ByVal nIDDlgItem As Long _ ) As Long Declare Function GetWindowDC Lib "user32" ( _ ByVal hWnd As Long _ ) As Long Declare Function ReleaseDC Lib "user32" ( _ ByVal hWnd As Long, _ ByVal hDC As Long _ ) As Long Declare Function SendMessageA Lib "user32" ( _ ByVal hWnd As Long, _ ByVal uMsg As Long, _ ByVal wParam As Long, _ ByVal lParam As Long _ ) As Long Dim hFont As Long Dim VMenu As IVMenuAuto Sub Main Dim hDC As Long Dim result As Integer hDC = GetWindowDC(0) Dim Height As Long Height = -FONT*GetDeviceCaps(hDC,LOGPIXELSY)/72 ReleaseDC 0,hDC hFont = CreateFontA(Height,0,0,0,0,0,0,0,0,0,0,0,0,"MS Sans Serif") Begin Dialog UserDialog 530,385,"Show Box",.DlgFunc ' %GRID:10,7,1,1 TextBox 10,7,500,336,.TextBox1,1 OKButton 60,357,90,21 CancelButton 210,357,90,21 End Dialog Dim dlg As UserDialog result = Dialog (dlg) If result = -1 Then ' If the user clicked OK, Clipboard dlg.TextBox1 ' copy the text box contents to the clipboard Wait .5 SendDragonKeys "{Ctrl+v}" ' and then paste them to the active application. End If DeleteObject hFont End Sub Rem See DialogFunc help topic for more information. Private Function DlgFunc(DlgItem$, Action%, SuppValue&) As Boolean Select Case Action% Case 1 ' Dialog box initialization Dim hWnd As Long hWnd = GetDlgItem(SuppValue,DlgControlId("TextBox1")) SendMessageA hWnd,WM_SETFONT,hFont,1 ' hWnd = GetDlgItem(SuppValue,DlgControlId("TextBox1")) ' SendMessageA hWnd,WM_SETFONT,hFont,1 ' Case 2 ' Value changing or button pressed Case 3 ' TextBox or ComboBox text changed Case 4 ' Focus changed Case 5 ' Idle Rem DlgFunc = True ' Continue getting idle actions DlgFocus("TextBox1") Case 6 ' Function key End Select End Function large edit selectionorall+large type edit selection/edit all commandstestýøÿÿ4 ' The bulk of this code is courtesy of Polar Engineering. Modifications made by Larry Allen of Softnet Systems, Inc. Option Explicit Const FONT=18 ' Approximate font size - change as required Const LOGPIXELSY = 90 Const WM_SETFONT = &H30 Declare Function CreateFontA Lib "gdi32" ( _ ByVal nHeight As Long, _ ByVal nWidth As Long, _ ByVal nEscapement As Long, _ ByVal nOrientation As Long, _ ByVal fnWeight As Long, _ ByVal fdwItalic As Long, _ ByVal fdwUnderline As Long, _ ByVal fdwStrikeOut As Long, _ ByVal fdwCharSet As Long, _ ByVal fdwOutputPrecision As Long, _ ByVal fdwClipPrecision As Long, _ ByVal fdwQuality As Long, _ ByVal fdwPitchAndFamily As Long, _ ByVal lpszFace As String _ ) As Long Declare Function DeleteObject Lib "gdi32" ( _ ByVal hObject As Long _ ) As Long Declare Function GetDeviceCaps Lib "gdi32" ( _ ByVal hDC As Long, _ ByVal nIndex As Long _ ) As Long Declare Function GetDlgItem Lib "user32" ( _ ByVal hDlg As Long, _ ByVal nIDDlgItem As Long _ ) As Long Declare Function GetWindowDC Lib "user32" ( _ ByVal hWnd As Long _ ) As Long Declare Function ReleaseDC Lib "user32" ( _ ByVal hWnd As Long, _ ByVal hDC As Long _ ) As Long Declare Function SendMessageA Lib "user32" ( _ ByVal hWnd As Long, _ ByVal uMsg As Long, _ ByVal wParam As Long, _ ByVal lParam As Long _ ) As Long Dim hFont As Long Dim VMenu As IVMenuAuto Sub Main Dim hDC As Long Dim result As Integer hDC = GetWindowDC(0) Dim Height As Long Height = -FONT*GetDeviceCaps(hDC,LOGPIXELSY)/72 ReleaseDC 0,hDC hFont = CreateFontA(Height,0,0,0,0,0,0,0,0,0,0,0,0,"MS Sans Serif") Begin Dialog UserDialog 530,385,"Show Box",.DlgFunc ' %GRID:10,7,1,1 TextBox 10,7,500,336,.TextBox1,1 OKButton 60,357,90,21 CancelButton 210,357,90,21 End Dialog Dim dlg As UserDialog ' If "All" -- now "everything", select all the text. If UtilityProvider.ContextValue(0) = "all" Then SendDragonKeys "{Ctrl+a}" ' Copy the selected text from the application. SendDragonKeys "{Ctrl+c}" ' Wait a little and then display the dialog. Wait .5 result = Dialog (dlg) If result = -1 Then ' If the user clicked OK, Clipboard dlg.TextBox1 ' copy the text box contents to the clipboard Wait .5 SendDragonKeys "{Ctrl+v}" ' and then paste them to the active application. End If DeleteObject hFont End Sub Rem See DialogFunc help topic for more information. Private Function DlgFunc(DlgItem$, Action%, SuppValue&) As Boolean Select Case Action% Case 1 ' Dialog box initialization Dim hWnd As Long hWnd = GetDlgItem(SuppValue,DlgControlId("TextBox1")) SendMessageA hWnd,WM_SETFONT,hFont,1 ' hWnd = GetDlgItem(SuppValue,DlgControlId("TextBox1")) ' SendMessageA hWnd,WM_SETFONT,hFont,1 ' ' paste the text and go to the top SendDragonKeys "{Ctrl+v}{Ctrl+Home}" Case 2 ' Value changing or button pressed Case 3 ' TextBox or ComboBox text changed Case 4 ' Focus changed Case 5 ' Idle Rem DlgFunc = True ' Continue getting idle actions DlgFocus("TextBox1") Case 6 ' Function key End Select End Function macro oneexecutes Word "macro1" macrotestýøÿWINWORDMicrosoft Word for WindowsMicrosoft CorporationÆ'#Reference {00020905-0000-0000-C000-000000000046}#8.3#0#D:\Program Files\Microsoft Office\OFFICE11\MSWORD.OLB#Microsoft Word 11.0 Object Library Sub Main Word.Application.Run "macro1" End Sub #sample Hearing