استخراج داده جدول از صفحات وب در اکسس

ماده 4 ـ ( بنیاد تعاون سپاه 1372 )

سرمایه اولیه بنیاد در تاریخ تأسیس ده میلیون ریال می باشد که از طرف مقام معظم رهبری و فرماندهی کل قوا اهداء گردیده است.

چنانچه مطلب مفید بود لطفا در نظرسنجی شرکت نمائید.

مطلب زیر استخراج داده های جدول موجود در سایت www.tuttitalia.it/regioni  است داخل فایل تکست 

دوستان هر کدام از مطالب این بلاگ چنانچه به شما در آموزش یا راهنمایی در کارتون کمک حالتون بود لطفا در نظرسنجی شرکت کنید   تماما از سایت های خارجی استخراج شده .

تماما کتابخانه ها در منو آیتم Refrences محیط VBE  موجود است اگر با آنها راحتید تیک بزنید مثل Microsoft Html Object Library ... با متد Refrences.Add هم می توانید تیک بزنید در رفرنس پراپرتی Count فقط تیک خورده ها را می شمرد!!!

https://docs.microsoft.com

https://docs.microsoft.com

msxml/list-of-xml-parser-versions

winhttp-functions

Set xmlReq = CreateObject("MSXML2.XMLHTTP")
xmlReq.Open  Get,uRl,0
xmlReq.Send

OBJECT : "HtmlFile"

For Each ele In objIE.document.getElementById("myTable").getElementsByTagName("tr")

        'show the text content of 'tr' element being looked at

        Debug.Print ele.textContent

        'each 'tr' (table row) element contains 4 children ('td') elements

        'put text of 1st 'td' in col A

        Sheets("Sheet1").Range("A" & y).Value = ele.Children(0).textContent

        'put text of 2nd 'td' in col B

        Sheets("Sheet1").Range("B" & y).Value = ele.Children(1).textContent

        'put text of 3rd 'td' in col C

        Sheets("Sheet1").Range("C" & y).Value = ele.Children(2).textContent

        'put text of 4th 'td' in col D

        Sheets("Sheet1").Range("D" & y).Value = ele.Children(3).textContent

        'increment row counter by 1

        y = y + 1

    'repeat until last ele has been evaluated

    Next

uRl: https://www.tuttitalia.it/regioni/      استخراج لینک ها

hDoc.body.innerHTML = xmlReq.responsetext

Set hEle = hDoc.body.getElementsByTagName("a")

Open "d:\ExtractLink.txt" For Output As #1

For Each h In hEle

If h.href Like "*https*" Then

Write #1, h.href, h.innertext

End If

Next

Close #1

در تصویر  زیر،  طبق کدهای بالا  ،  تکست های تگ a که داخلشون http بود به فایل تکست با نام ExtractLink ارسال شده.

Me.Text1 = hDoc.body.innertext

Dim mtbl As Object, table_data As Object

Set mtbl = hDoc.body.getElementsByTagName("Table")(0)

Set tblHeader = mtbl.getElementsByTagName("th")

Set tblRows = mtbl.getElementsByTagName("tr")  ' TAble Data

در جدول با ایندکس صفر چون Header حاوی اسکی کد اضافه بود اون رو با Replace حذف کردیم که زیر هم چاپ نشوند چون در حالت عادی از vbrclf استفاده شده بود که در استخراج تکست های هدر زیر هم چاپ میشد.

For Each h In tblHeader
ss = ss & IIf(ss = "", "Row", ";") & Replace(h.innerText, Chr(10), "")
Next
Me.Text1 = ss

تصویر زیر تکست های مربوط به هدر است البته عرض کردم یک کاراکتر اضافی دارن که باعث میشه زیر هم بیان با تابع Replace اون اسکی کد اضافی رو حذف کردیم.ستون اول Blank هست گفتیم بجاش کلمه Row جایگزین بشه در تصویر ملاحظه می کنید.

برای گرفتن تعداد ردیف ها و ستون ها در جدولی که در صفحه وب است از ویژگی length استفاده کنید.Zero Base و از صفر شروع میشود فقط اعدا صحیح

RowsCount = tblRows.length - 1     ' 21 

  6'   ColsCount = tblHeader.length - 1

در تصویر زیر داده های جدول با ایندکس صف ر در فایل تکست Print شده .  از Print Statement استفاده کنید بجای Write که کوتیشن اول و آخر تکست هاتون در هر ردیف نزنه... در کدها البته گفت شده اگر تکست هر ردیف از ستون خاص یا مربوطه Numeric نبود بین تکست استخراجی یک تک کوتیشن بزنه ... در تصویر مشاهده بنمائید.( در تصویر رشته غیر عددی بین دو تک کوتیشن قرار گرفته )

البته جلوی ردیف ها نقطه وجود دارد که می توان گفت اگر آخر رشته  نقطه بود برداشته شود .

txt="1."

t=Replace(Right$(txt,1),".","")

بخاطر اینکه از دستور Insert Into زبان Sql دیتابیس اکسس برای استخراج فایل تکست به داخل جدول اکسس قراره استفاده کنم می بایست عبارات غیر عددی یا تکست ، داخل تک کوتیشن قرار گیرد وگرنه ارور می دهد در نتیجه بهتر است برای جلوگیری از خطا تکست ها داخل تک کوتیشن قرار گیرد 

strSql=insert into Tbl1 (Fld1,,,Fldn) Values(val1,'txt1',,,,valn,'txtn')=

Docmd.RunSql   ' استفاده از متد 

پِراپِرتی  رکوردز اَفِکتِدِ کارِنت دی بی  

Dim fileStream As Object
Set fileStream = CreateObject("ADODB.Stream")
With fileStream
.Open
.Type = 2 'Text
.Charset = "utf-8"

.WroteText strtext,1

.SaveToFile "d:\dddddddd.txt",2

.Close

End With

این آبجکت متد LoadFromFile نیز دارد.فرضا دانلود تصویر از سایت  یا شئ رکودست 

Hex$(AscW(Mid(txt, i, 1)))

Set tbl = hdoc.getElementsByTagName("table")(0)

Set  tRows = tbl.getElementsByTagName("tr")

Debug.Print  tRows.length  '8 

تصویر زیر استخراج جدولی از سایت بانک مسکن است.برای اینکه حروف فارسی در فایل تکست کاراکتر نامعلوم یا ? نشود از آبجکت ADO STREAM استفاده شد و Charset به utf-8  تنظیم گردید. برای ارسال فایل تکست به جدول اکسس از تب External Data و گروه Import استفاده نمودیم. بین تکست ها در ارسال به فایل تکست از یک Delimiter یا  جدا کننده مثل سمی کالن  ( ; ) استفاده شد ( در تصویر زیر در تصویر notepad می توانید مشاهده نمائید ) که در مراحل import در قسمت مربوطه جداکننده اعلان شود تا هر کدام در فیلد جداگانه ثبت گردد. بدون دسترسی به کتابخانه ها یا فایل های tlb و dll هیچ کدام از مراحل زیر یا قابل انجام نیست یا به تخصص خیلی بالایی نیاز است.

CreateObject("MSXML2.XMLHTTP") 

'GET,WebFile,False

'oResp() As Byte = oXMLHTTP.responseBody 
     
    vFF = FreeFile 
    If Dir(vLocalFile) <> "" Then 
        Kill vLocalFile 
    End If 
    Open vLocalFile For Binary As #vFF 
    Put #vFF, , oResp 
    Close #vFF 

Set TagLink=hDoc.getelementsByTagName("link")

For Each Links in TagLink

Debug.Print Links.href  

Next

می توانید از Refrences محیط VBE  ، فایل های microsoft html object  و microsoft xml را تیک بزنید و استفاده کنید بجای ساختن Object 

Dim URL As String = "http://www.footballlocks.com/nfl_odds.shtml"
        Dim XMLHttp As MSXML2.XMLHTTP
        Dim HTMLDoc As HTMLDocument
        Dim table As HTMLTable
        Dim tableRow As HTMLTableRow
        Dim tableCell As HTMLTableCell

        XMLHttp = New MSXML2.XMLHTTP
        XMLHttp.open("GET", URL, False)
        XMLHttp.send()
        HTMLDoc = New HTMLDocument
HTMLDoc.body.innerHTML = XMLHttp.responseText
        table = HTMLDoc.getElementsByTagName("TABLE")(39)
        For Each tableRow In table.rows
            For Each tableCell In tableRow.cells
                Console.WriteLine(tableCell.innerText)
            Next
        Next

سوراخ‌کاری بدن یا پیرسینگ ( Piercing ) یا آژین‌کاری شامل سوراخ کردن یا بریدن قسمتی از اعضای بدن است که برای نصب جواهرات یا انداختن حلقه و آویز ایجاد می‌شود.

25 بهمن 1400 : ( فایل صوتی ) برخورد سپاه با شرکت یاس که قرار بود منابع مالی جنگ با داعش را تامین نماید و تامین هم ننمود : 

شرکت یاس چه بود و برای چه ایجاد شد؟

شرکت یاس در بحبوحه درگیری میدانی نیروی قدس سپاه با داعش و تروریستهای تکفیری و در شرایطی که دولت وقت حاضر به پشتیبانی از رزمندگان در میدان نبود، تاسیس شد. ( احتمال خیلی کم منظورش روحانی بوده استغفر...(

این شرکت قرار بود از طریق اجرای پروژه‌های عمرانی منابع مالی لازم را برای پشتیبانی از جبهه مقاومت تامین کند.

با این حال شرکت یاس نتوانست به طور کامل در اهداف اقتصادی خود موفق شود و از طرفی چون بیرون از ساختار سپاه و شهرداری ایجاد شده بود سیستمهای نظارتی این دو نهاد نتوانسته بودند نظارت موثری را در حین فعالیت این شرکت داشته باشند.

اما با مشکوک شدن فرماندهان سپاه به نحوه عملکرد شرکت، مجموعه نظارتی سپاه به موضوع ورود کرده و متوجه تخلف افرادی به نام محمود سجادی نیا (سیف) و عیسی شریفی می‌شوند و بلافاصله ضمن منحل کردن این شرکت، متخلفان را به دادگاه نظامی معرفی می‌کنند. محمود سیف و عیسی شریفی از افراد بیرون سپاه بودند که در پروژه یاس فعالیت می کردند.

عیسی شریفی نظامی سابق ایرانی است که معاونت هماهنگی امور مناطق شهرداری تهران را از مهر ۱۳۸۶ تا اردیبهشت ۱۳۹۶ بر عهده داشت و به «شهردار در سایه» ملقب شده بود. گفته می‌شود در دوران جنگ ایران و عراق از فرماندهان نیروی هوایی سپاه بوده‌است. او به مدت ۱۲ سال قائم مقام و معاون قالیباف در شهرداری تهران بوده‌است. ویکی‌پدیا

اتهام(های) جزایی: مشارکت در کلاهبرداری باندی، مشارکت در پولشویی و برداشت و تصاحب غیرقانونی وجوه

شاخه نظامی: سپاه پاسداران انقلاب اسلامینیروی انتظامی

https://fa.m.wikipedia.org

بهمن 1400 : عزل 1000 نفر از مدیران فاسد و نالایق اداره کار ( استخفر ... در جمهوری اسلامی   ) به روش عبدالملکی 

102 no Out

البته تصاویری که در این فیلم در ۲۶ بهمن ۱۴۰۰ پخش نشد.( مصادف با روز مرد )

حجت الاسلام مسعود عالی استاد حوزه در اظهاراتی از نوشین معراجی، فیلمنامه‌نویس «نمور» در پی مواضع اخیرش در خصوص روابط زن و مرد به شدت انتقاد کرد و گفت: آن خانم داوری که در جشنواره حرف ازدواج سفید را زد، مسئولین ارشاد تو دهنش باید می‌زدند. تو غلط میکنی ...

فارس نوشت:حجت الاسلام حسینی گفت: در جشنواره فجر انقلاب، سالیان متمادی است که به اسلام و انقلاب دهن کجی می کنند و مسؤولین امر سکوت می‌کنند. ازدواج سفید یعنی بدون تعهد و بدون ضوابط شرعی و طفل حاصل از آن را مباح دانستن، ترویج اباحه گری است

[;database;path;pwd=].[tb1]

HTML DOM Events

مطالعه بفرمائید لینک زیر را چون رویدادهاش در کنترل WebBrowser کاربرد دارند فرضا OnMouseDown که وقتی باتن چپ ماوس فشرده شده کاری را انجام دهد بعضی از آنها با Private Sub و بعضی هم با Private Function و نام رویداد + As Boolean اظهار می شوند.

w3schools

برای استفاده از ابزار html حتما در رفرنس ویژوال اکسس تیک html object library را بزنید.

برای استفاده از رویدادها حتما باید متغیر تنظیم شده ( دررویه DocumentComplete ) را با WithEvents در بالای تمام رویه ها در هر Mo dule اعلان کنید.

Private Sub WebBr0_DocumentComplete(Byval pDis As Object,url As Varaint)

Set htmlDoc=WebBr0.Document

End Sub

Dim IE As Object

Set IE=CreateObject("InternetExplorer.Application")

Set AllHyperlinks=IE.Document.getElementByClassName("product- list - container")(0).getElementByTagName("a")

For Each hyperlink in AllHyperlinks

Debug.print hyperlink.href & hyperlink.innerText

Next

WebBr0.Document.body.doscroll="no"

برای پیمایش به پائین ترین موقعیت webpage:

WebBr0.Document.parentwindow.scroll 0,4000

ParentWindow.event  متدهایی  دارد مثل ClientX و ClientY که در onmousemove می توان بهره برد یا KeyCode برای گرفتن کد کلید فشرده شده در رویداد onkeyup یا حتی onkeypress ( فرضا در این رویداد گفته میشود اگر کدها غیر از کد عدد 0 تا 9 بود عملی انجام نشود KeyCode=0 )

internet-explorer/ie-developer

X=1

Set NodeList=Doc.

getElementsByTagName("P")

For Each Elem In NodeList

Select Case X

       Case 2

              Debug.Print Elem.innerText

       Case 4

             Debug.Print Elem.innerText

End Select

X=X+1

Next

Private Sub Command1_Click()
   WebBrowser0.ControlSource = "=""C:\Users\Renaud\AppData\Local\Temp\map-simple.htm"""
End Sub

19 بهمن 1400 : هرچند نقش ویتامین دی در سلامت استخوان‌ها و سیستم ایمنی بدن شناخته شده بود اما تاکنون تاثیر آن بر علائم نوع حاد «کووید ۱۹» مشخص نشده بود.

تحقیقی که دانشمندان اسرائیلی انجام داده‌اند اولین پژوهشی است که در آن ارتباط سطح ویتامین دی در بدن فرد پیش از ابتلا به ویروس کرونا با بروز علائم حاد «کووید ۱۹» مورد بررسی قرار گرفته است.

مرگ بر اسرائیل !!!

آبجکت WebBrowserControl

IEXPLORE

WebControl_members

WebElement_properties

webbrowser-open-office-document-in-visual-basic

البته مطلب زیر تکرار مکررات است 

The WebBrowser control has several properties, methods, and events that you can use to implement controls found in Internet Explorer. For example, you can use the Navigate method to implement an address bar, and the GoBack , GoForward , Stop , and Refresh methods to implement navigation buttons on a toolbar

objects_and_controls

  Obj.ContextMenu = TRUE  'Boolean Type

در لینک زیر رویداد های یک اکتیو ایکس کنترل Webbrowser نشان داده 

vba/api/access.webbrowsercontrol

برای نمایش یک سایت در کنترل webbrowser که در اینجا نام کنترل WebBrowser0 است :

Me.WebBrowser0.Navigate "www.Blogsky.com"

فقط صفحات Html در این Browser قابل مشاهده هستند پس در این کنترل نمی توانید فایل Pdf یا Word  باز کنید.

برای Disable  کردن اجرای عملیات  در webbrowser یا باصطلاح خودمون عدم نمایش ، رویداد BeforeNavigate2 را مطالعه نمائید در تابع آرگومان آخر از نوع Boolean تعریف شده  که می توانید آنرا False کنید.

برای استفاده از کلاس ماژول هایی که Microsoft HTML DOCUMENT دارد در Refrence محیط VBE آنرا تیک بزنید همانطور که گفته شد WithEvents متغیری را تعریف می کند که می توانید به رویدادها دسترسی پیدا کنید البته آن متغیر تعریف شده را باید در تابع WebBrowser0_DocumentComplete به پراپرتی Document این کنترل تنظیم کنید.

Private WithEvents HDoc As HTMLDocument

در DocumentComplete که دو آرگومان دارد اولی بعنوان آبجکت و دومی url از نوع Variant بنویسید

Set HDoc=WebBrowser0.Document

از نحوه نوشتاری رویه هایی  که در HTMLDocunent  وجود  دارد اطلاعی ندارم و تنها چیزی که پیدا شد رویداد OnClick است  

Private Function Hdoc_OnClick() As Boolean

Msgbox " Clicked Me !!!)

End Function

در رویه بالا اگر شما Boolean را بکار نبرید خطا دریافت خواهید کرد. و حتما باید آنرا بکاربرد

غیر فعال کردن Scroll : 

Me.WebBrowser0.Document.Body.Scroll="No"

Event : NavigationStateChanged

دو تا آرگومان دارد و مقدار Boolean دارند یکی CanGoBack و دیگری CanGorward

powerscript_reference/mouseMove_event

WithEvents

Specifies that one or more declared member variables refer to an instance of a class that can raise events.

برای استفاده از عناصر مربوطه در Refrence تیک Microsoft Html library را حتما تیک بزنید البته بدون تیک هم می توان کارهایی  انجام داد که مجبور به تیک این آپشن نباشیم البته اگر فایل مربوطه در system32 نباشد دیگر هیچ کاری نمی توان انجام داد.

Public WithEvents ObjHtmlDoc As HTMLDocument

Private Sub WebBrowser1_NavigateComplete2(ByVal pDisp As Object, URL As Variant)

    Set objHtmlDoc = WebBrowser1.Document

End Sub

OnMouseMove Event :

زمانیکه ماوس را روی کنترل webbrowser می گیرید مختصات x و y را برمی گرداند 

First Tick  "Microsoft HTML Object Library"  Form VBA Refrences

Important :in Upper Sub Procedures Declared   Private WithEvents Doc Ass HTMLDocument ( To use Event )

Important : Set Variable Doc In Sub WebBrowser_DocumentComplete(Byval pDisp as Object,url As Varaint)

Doc_OnMouseMove

Me.text3=Me.Text3 = "X : " & dc.parentWindow.event.clientX & _

          "Y : " & dc.parentWindow.event.clientX

Doc_OnMouseMove

OnMouseUp Event

برای Scroll کردن در اکتیو ایکس WebBrowser به سمت پائین و انتهای body روش زیر پیشنهاد شده

To scroll to a specific location, you can use WebBrowser.Document.Window.ScrollTo(x,y) method. For example to scroll down to the end of body:

private void webBrowser1_DocumentCompleted(object sender, 
                                           WebBrowserDocumentCompletedEventArgs e)
{
    webBrowser1.Document.Window.ScrollTo(0, webBrowser1.Document.Window.Size.Height);
}

WebBrowser Events 

DocumentComlete  Event : 

زمانی فعال می شود که یک سند به طول کامل بارگیری و مقدار دهی اولیه شود ( "Object.Navigate="url )

نوشتاری : 

Private Sub WebBrowser0_DocumentComplete(ByVal iDisp As Object ,url As Variant)

WindowSetTop Event :

زمانی فعال می شود که شئ موقعیت Top اش را تغییر دهد

نوشتاری : 

Private Sub  object_WindowSetTop(ByVal nTop As Long)

Zoom Method : زوم کردن

طبق عبارت زیر می توانید صفحه را با درصد انتخابی Zoom in یا Zoom Out کنید.

Me.WebBrowser0.Document.body.Style.zoom = "220%"

Scroll Height :  ارتفاع اسکرول در صفحه

برای بدست آوردن ارتفاع اسکرول  طبق زیر عمل کنید

To Get Scroll Height Of Body ( Object Must Be Set )

Dim HtmlBody As HtmlBody

Set HtmlBody = Me.WebBrowser0.Document.body

MsgBox HtmlBody.scrollHeight

Click Button :  کلیک روی باتن

کلیک روی باتن طبق تصویر زیر و باز شدن منو با کلیک اول منو بازشد و کلیک دوم به حالت قبل برگشت.

HTMLElement . متد Click یک کلیک ماوس روی عنصری را شبیه سازی می کند  عنگامی که Click با عناصر پشتیبانی شده مانند <input> استفاده می شود ، رویداد کلیک عنصر را فعال می کند . این رویداد سپس به عناصر بالاتر در شاخه سند  ( یا زنجیره رویداد ) تبدیل می شود و رویداد کلیک آنها را فعال می نماید.

در تصویر Gif زیر کامند سمت چپ داکیومنت را در کنترل راهبری می کند و کامند سمت راست منو رو باز میکند البته در حالتی که کنترل وب براوزر را بازتر کنیم آن حالت راهبری بصورت Toggle از بین می رود و در form-header سه دکمه مثل "ورود به سیستم" نمایان می شود وعملا این کد خاصیتی ندارد. برای کلیک کردن روی سه باتن loging یا Signup می توانید ....... لوپ زدن در element  ها و چک کردن id یا href یا هر چیز دیگری و Ele.Click

شامل header و content و footer است.

.Document.GetElementsByTagName("Button")(0)

.innerText="Toggle Navigation"

getElementsByName و getElementsByClassName یک آرایه را باز می گردانند بنابراین باید ایندکس آیتم آرایه در براکت ها مشخص شود.

مطلب زیر هم جالبه برای انتخاب تمام کلاس ها با getElementsByClassName و Click

Select all class's with getElementsByClassName and click

var el = document.getElementsByClassName('node closed');

for (var i=0;i<el.length; i++) { 

el[i].click(); 

}

' Input the userid and password
    ie.Document.getElementById("uid").Value = "testID"
    ie.Document.getElementById("password").Value = "testPW"
' Click the "Search" button
    ie.Document.getElementById("enter").Click




Link

Set HTMLdoc = appIE.HTMLDocument
    Set link = Nothing
    i = 0
    While i < HTMLdoc.Links.Length And link Is Nothing
        If HTMLdoc.Links(i).innerText = "Favorites" Then Set link = HTMLdoc.Links(i)
        i = i + 1
    Wend
    If Not link Is Nothing Then
        link.Focus
        link.Click
    End If




برای کلیک کردن ، حتما متغیر که اینجا myLinks است باید تنظیم شود

Dim myLinks As Object
Set myLinks = Document.getElementsByTagName("a")

Add List the Link to ListBox

Private Sub Form_Load()
WebBrowser1.Navigate "www.vbforums.com"
End Sub


Dim HTMLdoc As HTMLDocument
Dim HTMLlinks As HTMLAnchorElement
Dim STRtxt As String
' List the links.
On Error Resume Next
Set HTMLdoc =WebBrowser1.Document
For Each HTMLlinks In HTMLdoc.links
    List1.AddItem HTMLlinks.href
    STRtxt = STRtxt & HTMLlinks.href & vbCrLf
Next HTMLlinks
'Append means add data to end
Open "C:\Documents and Settings\joe\Desktop\linklog.txt" For Append As #1
Print #1, STRtxt
Close #1
End Sub

CommandStateChange Event :

زمانی ر خ می دهد که حالت فعال یک فرمان  یا Command تغییر نماید 

Private Sub object_CommandStateChange (ByVal Command As Long,

ByVal Enable As Boolean)

Cmmand :
CSC_NAVIGATEFORWARD  ( Value : 1) The enabled state of the Forward button has changed. CSC_NAVIGATEBACK ( Value : 3 ) If Command = 2  Then Me.Command5.Enabled = Enable CommandStateChangeConstants enumeration How To Hide Or Show WebBrowser Control Me.WebBrowser0.Visible = False		The enabled statebutton has http:// changed.

باتنی می توان در فرم تعبیه کرد و از GoBack برای برگشتن به عقب استفاده کرد البته باتن Back د ر کیبورد همین کار را انجام میدهد

On Error Resume Next

Me.WebBrowser0.GoBack

وقتی صفحه وب کاملا Load شد اگر از Goback استفاده کنید ( در رویه یک باتن بنویسید )  با خطا مواجه می شوید چون صفحه قبلی وجود ندارد که شما را به آن بازگرداند ولی اگر از دکمه کیبورد ( Back ) استفاده کنید خطا دریافت نمی کنید ... کد اول بخاطر همین نوشته شد.

Print 

WebBrowser1.ExecWB OLECMDID_PRINT, OLECMDEXECOPT_DONTPROMPTUSER

'you can change OLECMDEXECOPT_DONTPROMPTUSER to OLECMDEXECOPT_PROMPTUSER if you wish

بجای استفاده از DONTPROMPTUSER می توانید از PROMPTUSER بهره ببرید برای اینکه به  کاربر اعلام  نماید و Dialog Box را نمایش دهد. از Shell هم می توان استفاده کرد .

Shell "rundll32.exe C:\WINDOWS\SYSTEM\MSHTML.DLL,PrintHTML " & _ "http://www.developerfusion.com" , vbMinimizedFocus

با SendKeys هم می توان کنترل + P را فرستاد  راه های رسیدن به پرینت صفحه.

To Fill Edit Box : 

WebBrowser1.document.all("username").Value = "Name"
WebBrowser1.document.all("password").Value = "passwort"
WebBrowser1.document.all("Submit").Click

OnMouseDown()

Private Declare Ptrsafe Function GetAsyncKeyState Lib "user32" (ByVal VKey As Long) As Integer

For Key = 1 To 5 '255
If GetAsyncKeyState(Key) Then  'WebBrowser1_MouseDown VKey
Exit For
End If
Next

If Key = 2 Then
Me.Label1 ="Right MouseDown"
End If 

استفاده از تابع ویندوری ShellExecute برای اجرای فایل 

Private Declare Function ShellExecute Lib "shell32.dll" _
Alias "ShellExecuteA" _
'Declare arguments
(ByVal hWnd As Long, ByVal lpszOp As String, _
ByVal lpszFile As String, ByVal lpszParams As String, _
ByVal LpszDir As String, ByVal FsShowCmd As Long) _
As Long

'Used to display a window
Const SW_SHOWNORMAL = 1

'Open pdf occurs on button click
Private Sub cmdPDF_Click()
Dim strPath, strParam As String

strPath = "C:\Example.pdf"
strParam = " /A " & Chr(34) & "page=14" & Chr(34) & strPath

Call ShellExecute(0&, "open", "AcroRd32.exe", strParam, "", SW_SHOWNORMAL)
End Sub

Remove Open\Save Dialog
------------------------------------------------------
Windows Registry Editor Version 5.00
[-HKEY_CLASSES_ROOT\AcroPDF.FDF.1]
[HKEY_CLASSES_ROOT\AcroPDF.PDF.1]
"EditFlags"=hex:00,00,01,00
------------------------------------------------------
Add Open\Save Dialog
------------------------------------------------------
Windows Registry Editor Version 5.00
[HKEY_CLASSES_ROOT\AcroPDF.FDF.1]
"EditFlags"=hex:00,00,00,00
[HKEY_CLASSES_ROOT\AcroPDF.PDF.1]
"EditFlags"=hex:00,00,00,00

لطفا بعد از مطالعه و استفاده فاتحه ای برای پدر مرحومم قرائت فرمائید .... دوستان عزیز لطفا در نظر سنجی شرکت کنید در ضمن مطالب زیر ربطی به اکسس ندارد و فقط برای مطالعه است

صرفا جهت مطالعه ، مطالب زیر ربطی به کنترل بالا ندارد . موارد  جدید مربوط به webbrowser اگر یافت شد به بالا اضافه خواهد شد.

WM_NCHITTEST=132

WM_SETCURSOR=32

WM_MOUSEMOVE=512

پیام ویندوزی ارسال به پنجره

WM_MOUSEMOVE   : 

Private Type POINTAPI
x As Long
y As Long
End Type

Contains information about a mouse event passed to a WH_MOUSE hook procedure, MouseProc.

Private Type MOUSEHOOKSTRUCT

pt As POINTAPI 

hwnd As Long 

wHitTestCode As Long 

dwExtraInfo As Long 

End Type

'Constants

Public Const WH_MOUSE = 7

Public Const WM_MOUSEMOVE = &H200

Public Const WM_LBUTTONDOWN=&H201
Public Const WM_LBUTTONUP=&H202
Public Const WM_LBUTTONDOWNDBLCLK=&H203
Public Const WM_RBUTTONDOWN=&H204
Public Const WM_RBUTTONUP=&H205
Public Const WM_RBUTTONUPDBLCLK=&H206

Private OldWndProc As Long 

Private IsHooked As Boolean 

Public Function MouseProc(ByVal uCode As Long, ByVal wParam As LongPtr, lParam As MOUSEHOOKSTRUCT) As Long

If uCode < 0 Then 

MouseProc = CallNextHookEx(lpPrevWndProc, uCode, wParam, lParam) 

Else 

Select Case wParam 

Case WM_MOUSEMOVE 

'here is your mouse move event 

Debug.Print "Mouse Move: " &  lParam.pt.x & lParam.pt.y 

End Select 

MouseProc = CallNextHookEx(OldWndProc, uCode, wParam, lParam) 

End If 

End Function

 
Public Sub SetMouseHook()
If Not IsHooked Then
OldWndProc = SetWindowsHookEx(WH_MOUSE, AddressOf MouseProc, 0, GetCureantThreadID)
IsHooked = True
End If
End Sub

 Public Sub RemoveMouseHook()
UnhookWindowsHookEx OldWndProc
IsHooked = False
End Sub 

SubClass Window

Public Declare PtrSafe Function SetWindowLongPtrA Lib "user32" (ByVal Hwnd As LongPtr, _

ByVal nIndex As Long, ByVal dwNewLong As LongPtr) As LongPtr

Public Declare PtrSafe Function CallWindowProcA Lib "user32.dll (ByVal lpPrevWndFunc As LongPtr, _

ByVal Hwnd As LongPtr, ByVal Msg As Long,  _

ByVal wParam As LongPtr, ByVal lParam As LongPtr) As LongPtr

Public OldWndProc As LongPtr

Public IsHooked As Boolean

Public cCount As LongLong

Public Sub SubClass()

If Not IsHooked Then

OldWndProc = SetWindowLongPtrA(Hwnd, GWLP_WNDPROC, AddressOf NewWndProc)

IsHooked = True

End If

End Sub

Public Sub UnSubClass()

SetWindowLongPtrA Hwnd, GWLP_WNDPROC, OldWndProc

IsHooked = False

End Sub

Public Function  NewWndProc (ByVal Hwnd As LongPtr,ByVal Msg As Long,ByVal wParam As LongPtr,ByVal lParam As LongPtr) As LongPtr

Select Case Msg

         Case &H201

                  Debug.Print  "&H201"

         Case &H202

                  Debug.Print "&H202"

        Case Else 

NewWndProc=0

End Select 

NewWndProc=CallWindowProcA(OldWndProc,Hwnd,Msg,wParam,lParam)

End Function

WM_MOUSE         : 

هنگامی که مکان نما حرکت می کند به یک پنجره ارسال می شود. اگر ماوس گرفته نشود، پیام به پنجره ای که مکان نما را در خود دارد ارسال می شود. در غیر این صورت، پیام به پنجره ای که ماوس را گرفته ارسال می شود.

پنجره این پیام را از طریق تابع WindowProc خودش دریافت می کند.

WM_MOUSEMOVE=&H200
wParam : are Down virtual keys or not
1-The left mouse button is down.
2-The right mouse button is down
4- The SHIFT key is down.
8-The CTRL key is down.
10-The middle mouse button is down.
20- The first X button is down.
40- The second X button is down.
lParam : مختصات کرسر

If Msg=&H200 And wParam=2 Then 

Debug.Print cCount=cCount+1

WindowProc=False Or True ( To Be Tested)

End If

WM_CONTEXTMENU :

اطلاع میدهد به پنجره ای که کاربر مایل است یک منوی زمینه ظاهر شود. کاربر ممکن است در پنجره با ماوس right-click کرده باشد ، Shift+F10 را فشرده باشد یا از کلیدهای برنامه استفاده کند

WM_CONTEXTMENU=&H7B
wParam :

هندلی است به پنجره ای که کرسر با ماوس right-click شده . می تواند یک زیرپنجره برای پنجره ای باشد که پیام دریافت می کند.

lParam :

قسمت  low-order موقعیت افقی کرسر را تعیین می کند ، در مختصات صفحه ، در زمان ماوس کلیک

Clng(lparam And 255×257)

قسمت high-order موقعیت عمودی کرسر را مشخص می کند ، در مختصات صفحه ، در زمان کلیک کردن روی ماوس

Clng(lparam \ 255×257)

Public Declare PtrSafe Function PtInRect Lib "user32.dll" (lpRect As RECT, ByVal x As Long, ByVal y As Long) As Long

Public  Type Pt As POINTAPI

x As Long

y As Long

End 

Public rc As Rect

Left As Long

Top As Long

Right As Long

Bottom As Long

End Type 

Immediate Window :

گرفتن هندل Webbrowser

Public Declare PtrSafe Function GetClassName Lib "user32" Alias "GetClassNameA" ( _ ByVal hwnd As LongPtr, _ ByVal lpClassName As String, _ ByVal nMaxCount As Long) As Long

Public Declare PtrSafe Function EnumChildWindows Lib "user32" ( _ ByVal hWndParent As LongPtr, _ ByVal lpEnumFunc As LongPtr, _ ByVal lParam As LongPtr) As Long

برای گرفتن نام کلاس زیر پنجره ها یا Child Window که درون Parent Window هستند از تابع GetClassNameA استفاده می شود ( فرضا در پنجره ویندوزی  32770# باتن ها یک Child Window هستند ) در ویدوز 64 بیت یک ptrsafe قبل از عبارت Function نیاز است و دقیقا نام تابع به حروف کوچک و بزرگ حساس هستند یعنی اگر بنویسید getClassNameA با خطا مواجه خواهید شد. 

در تابع ویندوزی زیر hWnd میشود Form.hWnd که خوشبختانه اکسس این پراپرتی رو تعبیه کرده و WNDENUMPROC هم بدین شکل اعلام میشود AddressOf CallBackEnumWindowsProc.

BOOL  EnumChildWindows( [in, optional] HWND hWndParent, [in] WNDENUMPROC lpEnumFunc, [in] LPARAM lParam );

تابع EnumWindowsProc اگر برابر یک باشد در پنجره ها لوپ می زند و hWnd آنرا ارائه می نماید  اگر در تابع صفر بگذارید متوقف میشود و لوپ تعطیل میشود

BOOL CALLBACK EnumWindowsProc( _In_ HWND   hwnd, _In_ LPARAM lParam );

EnumWindowsProc=1

در این تابع که یک CallBack  است با GetClassNameA نام کلاس پنجره را میگیرید. این تابع را ملاحظه کنید ، آرگومان دوم lpClassName از نوع رشته ای است پس شما یک متغیر با نام Buffer بسازید و در آن vbNullChar یا هر کارکتر دیگری بنویسید مثل (Buffer$=String(255,vbNullChar و جای آن آرگومان می گذارید که نام کلاس درون این بافر قرار داده می شود شما می توانید طول رشته را بجای 255 مثلا 64 بگذارید . زمان اجرای GetClassName داخل بافر نام کلاس درج می گردد شما 255 بایت یا کاراکتر( Null )  ایجاد کردید قطعا نام کلاس خیلی کمتر از 255 بایت است و بقیه همان NullChar است پس با تابع Instr دنبال NullChar می گردید که بعد از نام کلاس قرار گرفته و تعداد کارکتر پشت اولین NullChar یافته شده را با این تابع میگیرید منهای یک می کنید که تعداد کاراکتر کلاس بدون آن کاراکتر Null بدست آید سپس با تابع Left آنرا از $Buffer استخراج می کنید . 

کنترل webbrowser که یک اکتیو ایکس است برای باز کردن internet explorer در آن پس نام کلاس هم برگرفته از آن است.

کنترل WebBrowser یک Wrapper یا پوشش است با نام Shell Embedding و حاوی internet Explorer_Server . می توان با فراخوانی توابع Api با نام FindWindowEx از کتابخانه user32 هندل ویندو یا hwnd آنرا دریافت کنید و  برای هندل interner Explorer_Server که یک ClassName است باید در پنجره های Child این پوشش  لوپ بزنید.

نحوه اظهار توابع API در ویندوز 32 و 64 بیت متفاوت هست یک خطا در اظهار یا حتی مغایرت در  دیتا تایپ باعث هنگ کردن خواهد شد.

تابع SetDlgItemTexA 

عنوان یا تکست یک کنترل در دیالوگ باکس را تنظیم می کند فرضا کنترل باتن به نام Yes یا هر Caption دیگری که دارد.

سه آرگومان دارد اولی هندلی به دیالوگ باکس که حاوی کنترل است ، دومی ID دیتا تایپ int و سومی از نوع String که حاوی text است که می خواهید به پنجره کنترل بفرستید که Caption آن تغییر نماید.