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

ماده 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]