Attribute VB_Name = "modIEAutomatiseren" Dim oIE As InternetExplorer Sub GetForumPosts() On Error GoTo ErH s = Timer Set oIE = CreateObject("InternetExplorer.Application") 'de verschilldende forums Helpmij Worksheet Ozgrid MrExcel TM1forum Columns(1).NumberFormat = "#" oIE.Quit Set oIE = Nothing MsgBox "Klaar." & vbNewLine & "(in " & Format(Round(Timer - s, 2) / 86400, "hh:mm:ss") & ")", vbInformation, "Status" Exit Sub ErH: If Not oIE Is Nothing Then oIE.Quit: Set oIE = Nothing MsgBox "Error " & Err.Number & ":" & vbNewLine & Err.Description, vbCritical, "Onverwachte foutmelding" End Sub Private Sub Helpmij() Const sURL As String = "http://www.helpmij.nl/forum/member.php/56678-Wigi" NavigateTo sURL With oIE [A1] = CDbl(.Document.getElementsByTagName("dd")(7).innerText) Rem [A1] = CDbl(Split(.Document.getElementsByTagName("dl")(7).innerText, "Totaal aantal berichten")(1)) End With End Sub Private Sub Worksheet() Const sURL As String = "http://www.worksheet.nl/forumexcel/member.php?u=1496" NavigateTo sURL [A2] = CDbl(oIE.Document.getElementsByTagName("dd")(8).innerText) Rem [A2] = CDbl(Split(oIE.Document.getElementsByTagName("dl")(3).innerText, "Totaal aantal berichten")(1)) End Sub Private Sub Ozgrid() Dim InputElement As MSHTML.HTMLInputElement Dim l As MSHTML.HTMLLinkElement Const sURL As String = "http://www.ozgrid.com/forum/member.php?u=15727" NavigateTo sURL With oIE.Document 'inloggen .getElementsByName("vb_login_username")(0).Value = "wigi" 'gebruikersnaam .getElementsByName("vb_login_password")(0).Value = "***" 'paswoord .getElementsByName("cookieuser")(0).Checked = False 'herinner mij niet For Each InputElement In .getElementsByTagName("INPUT") If UCase(InputElement.Value) = "LOG IN" Then InputElement.Click Exit For End If Next LoadPage NavigateTo sURL [A3] = .getElementsByTagName("dd")(16).innerText Rem [A3] = Split(.getElementsByTagName("dl")(14).innerText, "Total Posts")(1) 'uitloggen For Each l In .Links If UCase(l.innerText) = "LOG OUT" Then l.onclick = """" l.Click Exit For End If Next End With LoadPage Set l = Nothing: Set InputElement = Nothing End Sub Private Sub MrExcel() Dim InputElement As MSHTML.HTMLInputElement Dim l As MSHTML.HTMLLinkElement Const sURL As String = "http://www.mrexcel.com/forum/member.php?u=64825" NavigateTo sURL With oIE.Document 'inloggen .getElementsByName("vb_login_username")(0).Value = "wigi" 'gebruikersnaam .getElementsByName("vb_login_password")(0).Value = "***" 'paswoord .getElementsByName("cookieuser")(0).Checked = False 'herinner mij niet For Each InputElement In .getElementsByTagName("INPUT") If UCase(InputElement.Value) = "LOG IN" Then InputElement.Click Exit For End If Next LoadPage NavigateTo sURL [A4] = .getElementsByTagName("dd")(8).innerText Rem [A4] = WorksheetFunction.Clean(Split(.Document.getElementsByTagName("dl")(3).innerText, "Total Posts")(1)) 'uitloggen For Each l In .Links If UCase(l.innerText) = "LOG OUT" Then l.onclick = """" l.Click Exit For End If Next End With LoadPage Set l = Nothing: Set InputElement = Nothing End Sub Private Sub TM1forum() Dim InputElement As MSHTML.HTMLInputElement Dim l As MSHTML.HTMLLinkElement Const sURL As String = "http://www.tm1forum.com/ucp.php" NavigateTo sURL With oIE.Document 'inloggen .getElementsByName("username")(0).Value = "wim gielis" .getElementsByName("password")(0).Value = "***" .getElementsByName("autologin")(0).Checked = False .getElementsByName("viewonline")(0).Checked = False For Each InputElement In .getElementsByTagName("INPUT") If UCase(InputElement.Value) = "LOGIN" Then InputElement.Click Exit For End If Next LoadPage NavigateTo sURL [A5] = Split(.getElementsByTagName("dd")(2).innerText, "|")(0) Rem [A5] = Split(Split(.getElementsByTagName("dl")(0).innerText, "Total posts:")(1), "|")(0) 'uitloggen For Each l In .Links If InStr(UCase(l.innerText), "LOGOUT") Then l.Click Exit For End If Next End With LoadPage Set l = Nothing: Set InputElement = Nothing End Sub Private Sub NavigateTo(URL As String) Call oIE.Navigate(URL) Call LoadPage End Sub Private Sub LoadPage() With oIE Do While .Busy Or .ReadyState <> READYSTATE_COMPLETE 'Application.Wait DateAdd("s", 1, Now) DoEvents Loop End With End Sub Sub SetReference() On Error Resume Next ' Adds a reference to MS Internet Controls ThisWorkbook.VBProject.References.AddFromGuid "{EAB22AC0-30C1-11CF-A7EB-0000C05BAE0B}", 1, 1 End Sub