[AccessD] Your fav Code

MartyConnelly martyconnelly at shaw.ca
Wed Sep 20 14:11:22 CDT 2006


Well here are 3 example routines to call up an IE window from access
I use to display long text lists in a scrollable window, or to display 
things
like pdf, xls, xml  or tiff files obtained either locally or remote.
 or grab you ip address. Also avoids MS web browser control.
I don't mind if you use any of my code.


Sub IEHotfixes()
'------------------
'List Windows Hotfixes in IE Window via WMI
'Need two references set

'WMI Extension to DS 1.0 Type Library
' C:\Windows\System32\wbem\wbemads.tlb
'WMICntl 1.0 Type Library
' C:\Windows\System32\wbem\wbemcntl.dll
'takes 10 seconds for first wmi query

Dim objExplorer As Object
Dim objDocument As Object
Dim strComputer As String
Dim objWMIService As Object
Dim colLoggedEvents As Object
Dim objEvent As Object
Dim dtmDate As Variant
Dim strReturn As String

Set objExplorer = CreateObject("InternetExplorer.Application")
objExplorer.Navigate "about:blank"
objExplorer.Toolbar = 1
objExplorer.StatusBar = 0
objExplorer.Width = 800
objExplorer.Height = 570
objExplorer.Left = 0
objExplorer.Top = 0
objExplorer.Visible = 1

Do While (objExplorer.Busy)
Loop

Set objDocument = objExplorer.Document
objDocument.Open

objDocument.Writeln "<html><head><title>Automatic Updates Installation 
History</title></head>"
objDocument.Writeln "<body bgcolor='white'>"
objDocument.Writeln "<table width='100%'>"
objDocument.Writeln "<tr>"
objDocument.Writeln "<td width='20%'><b>Computer Name</b></td>"
objDocument.Writeln "<td width='50%'><b>Installed Update(s)</b></td>"
objDocument.Writeln "<td width='50%'><b>Date and Time Installed</b></td>"
objDocument.Writeln "</tr>"

strComputer = "."
Set objWMIService = GetObject("winmgmts:" _
    & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
    'IE Event code=19 WinXP=4377
Set colLoggedEvents = objWMIService.ExecQuery _
        ("SELECT * FROM Win32_NTLogEvent WHERE Logfile = 'System' AND " _
            & "EventCode = '19' OR EventCode = '4377'")
Dim i As Long
For Each objEvent In colLoggedEvents
    dtmDate = objEvent.TimeWritten
    strReturn = WMIDateStringToDate(dtmDate)

    objDocument.Writeln "<tr>"
    objDocument.Writeln "<td width='20%'>" & objEvent.ComputerName & "</td>"
    objDocument.Writeln "<td width='50%'>" & objEvent.Message & "</td>"
    objDocument.Writeln "<td width='50%'>" & strReturn & "</td>"
    objDocument.Writeln "</tr>"
    i = i + 1
Next
Debug.Print "no of events=" & i
objDocument.Writeln "</table>"
objDocument.Writeln "</body></html>"
'objDocument.Write()
objDocument.Close
MsgBox "finished"
Set objExplorer = Nothing
Set objDocument = Nothing
Set objWMIService = Nothing
Set colLoggedEvents = Nothing
Set objEvent = Nothing
End Sub
Function WMIDateStringToDate(dtmDate)
Debug.Print dtmDate
    WMIDateStringToDate = CDate(Mid(dtmDate, 5, 2) & "/" & _
        Mid(dtmDate, 7, 2) & "/" & Left(dtmDate, 4) _
            & " " & Mid(dtmDate, 9, 2) & ":" & _
                Mid(dtmDate, 11, 2) & ":" & Mid(dtmDate, _
                    13, 2))
End Function


Function GrabIPaddress()
'------------------
'Get IP address from dynds.org

Dim objExplorer As Object
Dim objDocument As Object

Dim strHTML As String

Set objExplorer = CreateObject("InternetExplorer.Application")
'Set objDocument = objExplorer.Document
objExplorer.Navigate "about:blank"
objExplorer.Toolbar = 0
objExplorer.StatusBar = 0
objExplorer.Width = 800
objExplorer.Height = 570
objExplorer.Left = 0
objExplorer.Top = 0
objExplorer.Visible = 1

objExplorer.Navigate "http://checkip.dyndns.org/"
Do While (objExplorer.Busy)
Loop


strHTML = objExplorer.Document.BODY.parentElement.outerHTML
 Debug.Print strHTML

GrabIPaddress = strHTML
'MsgBox "finished"
Set objExplorer = Nothing

End Function


Sub testIEvarious()
'------------------
' display various formats Tiffs PDF XLS local or remote
'If you add a reference to "Microsoft Internet Controls"
'(SHDOCVW.DLL) you should be able to do:
'Public IE as .... and find "InternetExplorer" in the popup menu.
'So then you have what you wrote, which is early-bound,
'and you can use that as follows:

'   Public IE As InternetExplorer
'   Set IE = New InternetExplorer

Dim objExplorer As Object
Dim strReturn As String

Set objExplorer = CreateObject("InternetExplorer.Application")
'Set objDocument = objExplorer.Document
objExplorer.Navigate "about:blank"
objExplorer.Toolbar = False
objExplorer.StatusBar = False
objExplorer.MenuBar = True
objExplorer.FullScreen = False
objExplorer.AddressBar = False

objExplorer.Width = 800
objExplorer.Height = 570
objExplorer.Left = 0
objExplorer.Top = 0
objExplorer.Visible = 1
'objExplorer.Navigate "http://www.databaseadvisors.com/"
'objExplorer.Navigate "192.168.0.1/st_devic.html"
'objExplorer.navigate "http://checkip.dyndns.org/"
objExplorer.Navigate "http://www.adobe.com/prodlist.pdf#page=3"
'objExplorer.navigate "C:\records management\aircanadacasestudy.pdf#page=4"
'objExplorer.Navigate "C:\records management\Copy of rim_guide_sarbanes.xls"
'objExplorer.Navigate 
"http://www.swimseattle.org/Forms/ScholorshipPolicy2003-2004.pdf"
'objExplorer.Navigate "file://C:\records 
management\aircanadacasestudy.pdf#page=3"
'objExplorer.navigate "C:\records management\aircanadacasestudy.pdf#page=2"
'objExplorer.Navigate 
"http://www.adobe.com/products/server/pdfs/customer_FAQ.pdf#page=3&zoom=200,250,100"
'objExplorer.Navigate "C:\Documents and Settings\marty\My Documents\My 
Pictures\VS.tif"
'objExplorer.Navigate "res://msxml.dll/defaultss.xsl"
Do While (objExplorer.Busy)
Loop

MsgBox "finished"
Set objExplorer = Nothing

End Sub



Martin Reid wrote:

>Folks
> 
>I was just t hinking. I am due to have soemthing published adn some of you give me permission to use some of your posting on AccessD. What I am also thinking of is a section called Developers Favourite Function/Code
> 
>I would add in your most useful bit of code with your name beside it. 
> 
>So if anyone would like to do this email me the example of list and I will add it in if I get enough examples. 
> 
>I think Access users etc would enjoy that.
> 
> 
>Martin
> 
>Martin WP Reid
>Training and Assessment Unit
>Riddle Hall
>Belfast
> 
>tel: 02890 974477
> 
> 
>  
>
>------------------------------------------------------------------------
>
>No virus found in this incoming message.
>Checked by AVG Free Edition.
>Version: 7.1.405 / Virus Database: 268.12.5/451 - Release Date: 19/09/2006
>  
>

-- 
Marty Connelly
Victoria, B.C.
Canada




More information about the AccessD mailing list