Revision Summary Date Revision History Revision Class Comments
06/30/2008     0.9     Major     First release. Additional indexing and cross referencing as well as minor editorial and technical edits anticipated prior to 1.0 release.
06/30/2009    0.95    Major    Updated to include preliminary information on the VBA language from the pre-release version of VBA 7.
03/15/2010    1.0    Major    Updated to include information on the VBA language as of VBA 7.
03/15/2012    1.01    Major    Updated to include information on the VBA language as of VBA 7.1, as shipped in the Office 15 Technical Preview.
04/30/2014    1.02    Editorial    Revised and edited technical content.

Set Dict = CreateObject("Scripting.Dictionary")
On Error Resume Next
Dict.Add "Key1", "Data"
Dict.Add "Key2", "Data"
Dict.Add "Key3", "Data"
If Err.Number <> 0 then
    If LCase(Arg(1)) = "l" then
        Dict.Remove Line
        Dict.Add Line, ""
    End If
End If
For Each thing in Dict.Keys()
    Msgbox thing
Next

Set rs = CreateObject("ADODB.Recordset")
With rs
.Fields.Append "SortKey", 4
.Fields.Append "Txt", 201, 5000
.Open
.AddNew
.Fields("SortKey").value = 1
.Fields("Txt").value = "Line1"
.UpDate
.AddNew
.Fields("SortKey").value = 2
.Fields("Txt").value = "Line2"
.UpDate
.AddNew
.Fields("SortKey").value = 3
.Fields("Txt").value = "Line3"
.UpDate

'Sorting
.Sort = "SortKey ASC"

'Filtering
.filter = "Sortkey < 3"

'Writing it out
Do While not .EOF
    MsgBox .Fields("Txt").Value
    .MoveNext
Loop

Set emailObj      = CreateObject("CDO.Message")
emailObj.From     = "dcandy@gmail.com"
emailObj.To       = "dcandy@gmail.com"
emailObj.Subject  = "Test CDO"
emailObj.TextBody = "Test CDO"
emailObj.AddAttachment "C:/Users/David Candy/Desktop/err.fff"
Set emailConfig = emailObj.Configuration
emailConfig.Fields("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.gmail.com"
emailConfig.Fields("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 465
emailConfig.Fields("http://schemas.microsoft.com/cdo/configuration/sendusing")    = 2
emailConfig.Fields("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
emailConfig.Fields("http://schemas.microsoft.com/cdo/configuration/smtpusessl")      = true
emailConfig.Fields("http://schemas.microsoft.com/cdo/configuration/sendusername")    = "dc"
emailConfig.Fields("http://schemas.microsoft.com/cdo/configuration/sendpassword")    = "S1"
emailConfig.Fields.Update
emailObj.Send
If err.number = 0 then
    Msgbox "Done"
Else
    Msgbox err.number & " " & err.description
    err.clear
End If

Set fso = CreateObject("Scripting.FileSystemObject")
    Set Outp = Wscript.Stdout
    Set wshShell = CreateObject("Wscript.Shell")
    Set ShApp = CreateObject("Shell.Application")
    On Error Resume Next
'   Have to use MSXML2 as Microsoft.XMLHTTP caused Access Denied errors after the page had been repeatedly gotten, go figure that one
    Set File = WScript.CreateObject("MSXML2.ServerXMLHTTP.4.0")
    Set File = WScript.CreateObject("Microsoft.XMLHTTP")
    File.Open "GET", "https://definitionupdates.microsoft.com/download/definitionupdates/safetyscanner/x86/msert.exe:200", False
    File.setRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 8.0; Windows NT 6.0; Trident/4.0; SLCC1; .NET CLR 2.0.50727; Media Center PC 5.0; .NET CLR 1.1.4322; .NET CLR 3.5.30729; .NET CLR 3.0.30618; .NET4.0C; .NET4.0E; BCD2000; BCD2000)"
    File.Send
    If err.number <> 0 then
        emsg= emsg &  ""
        emsg= emsg &  "Error getting file"
        emsg= emsg &  "=================="
        emsg= emsg &  ""
        emsg= emsg &  "Error " & err.number & "(0x" & hex(err.number) & ") " & err.description
        emsg= emsg &  "Source " & err.source
        emsg= emsg &  ""
        emsg= emsg &  "HTTP Error " & File.Status & " " & File.StatusText
        Outp.writeline File.getAllResponseHeaders
    else
        On Error Goto 0
        Set BS = CreateObject("ADODB.Stream")
        BS.type = 1
        BS.open
        BS.Write File.ResponseBody
        msgbox ShApp.Namespace(&h10).self.path & "safetyscanner.exe"
        BS.SaveToFile ShApp.Namespace(&h10).self.path & "safetyscanner.exe", 1
        wshshell.Run ShApp.Namespace(&h10).self.path & "safetyscanner.exe", 1, False
    End If

Set oShell = CreateObject("Shell.Application")
oShell.ShellExecute "Notepad.exe", , , "runas", 1

Set objWMIService = GetObject("winmgmts:\.rootCIMV2")
Set objEvents = objWMIService.ExecNotificationQuery _
    ("SELECT * FROM Win32_ProcessTrace")
    Do
        Set objReceivedEvent = objEvents.NextEvent
        If objReceivedEvent.ProcessName = "svchost.exe" then msgbox objReceivedEvent.ProcessName
    Loop

Set objVoice = CreateObject("SAPI.SpVoice")
Set objStream = CreateObject("SAPI.SpFileStream")
objVoice.Speak "hello there"

Set TS = CreateObject("Schedule.Service")
TS.Connect("Serenity")
Set rootFolder = TS.GetFolder("")
Set tasks = rootFolder.GetTasks(0)
If tasks.Count = 0 Then
    Wscript.Echo "No tasks are registered."
Else
    WScript.Echo "Number of tasks registered: " & tasks.Count
    For Each Task In Tasks
    A=Task.Name
    A = A & " " & Task.NextRunTime
    A = A & " " & Task.LastTaskResult
    wscript.echo A
    Next
End If

Set xlBook = GetObject("C:UsersDavid CandyDocumentsSuper.xls")
For each wsheet in xlbook.worksheets
    msgbox wsheet.name
next

Set ie = CreateObject("InternetExplorer.Application")
ie.AddressBar = 0
ie.Visible = 1
ie.ToolBar = 0
ie.StatusBar = 0
ie.Left = 400
ie.Top = 100
ie.Width = 800
ie.Height = 900
ie.Navigate2 "file:///c:/users/somefile.htm"

Declare Function GetOpenClipboardWindow Lib "User32.dll" () As Long
Declare Function GetLastError Lib "kernel32" () As Long
Public Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As Long, lpdwProcessId As Long) As Long
Public Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long
Public Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Public Declare Function CloseClipboard Lib "user32" () As Long
Public Declare Function GetActiveWindow Lib "user32" () As Long

Sub Main()
Ret = OpenClipboard(0)
If Ret = 0 Then
    MsgBox "Cannot open clipboard." & vbCrLf & vbCrLf & "Error Numbers are " & Err.LastDllError & "/" & GetLastError() & vbCrLf & vbCrLf & "An open clipboard doesn't generate an error message. To see what might be the problem if a error number is non zero, Type in a command prompt" & vbCrLf & vbCrLf & "net helpmsg <number>" & vbCrLf & vbCrLf & "Attempting to find the process with the clipboard open ..."
    Ret = GetOpenClipboardWindow()
    If Ret = 0 Then
        MsgBox "Can't find open clipboard" & vbCrLf & Ret & vbCrLf & Err.LastDllError & vbCrLf & GetLastError()
    Else
        PID = 1
        C = GetWindowThreadProcessId(Ret, PID)
        If PID <> 1 Then
            MsgBox "PID of Process with clipboard opened is " & vbCrLf & PID & vbCrLf & vbCrLf & "Use Task Manager to match the PID with a Process name or use MSInfo32's Running Task Page which also lists the path to the process."
        Else
            MsgBox "Clipboard is opened but not by a program with a window." & vbCrLf & "Thread ID is " & C
        End If
    End If
Else
    Ret = CloseClipboard()
    If Ret = 0 Then
        MsgBox "Error Closing Clipboard # " & Err.LastDllError
    Else
        MsgBox "Sucessfully opened and closed the clipboard. Does not appear to be any problems."
    End If
End If

End Sub