Public Declare Sub Sleep Lib "kernel32"(ByVal dwMilliseconds As Long) Public Function openDevNet() As InternetExplorer Dim ie As InternetExplorer Dim retryCnt As Integer retryCnt = 5 Set ie = New InternetExplorer ie.Visible = True RETRY_LOAD: On Error Resume Next Sleep 1000 Ie.Navigate2 "http://qmsrv041.nndn.nri.co.jp/Top/Aa/fap0000.htm" If Err.Number <> 0 Then Err.Clear If retryCnt = 0 Then Set ie = Nothing Set openDevNet = Nothing Exit Function End If retryCnt = retryCnt - 1 GoTo RETRY_LOAD End If Set ie = Nothing Sleep 1000 Set ie = getIEByTitle("DevelopersNet") Call waitIE(ie) ie.document.all("kaisha").value = "your kaisha code" ie.document.all("user").value = "your user ID" ie.document.all("pass_in").value = "your password" Call ie.document.all("logon").Click Set ie = Nothing RETRY_BIZMART_LOGON: DoEvents Set ie = getIEByTitle("BizMart ログオン") Call getImageByAlt(ie, "ログオン").Click Set ie = Nothing Set ie = getIEByTitle("BizMart") If ie Is Nothing Then GoTo RETRY_BIZMART_LOGON Call getLinkByInnerText(ie, "PROCENTERトップ").Click Call waitIE(ie) Set ie = getIEByTitle("PROCENTER") Set openDevNet = ie End Function Public Function getIEByTitle(title As String, Optional bExactMatch = True) As InternetExplorer Dim objShell As Object Dim objWin As Object Dim retryCnt As Integer retryCnt = 5 RETRY_: Set getIEByTitle = Nothing Set objShell = CreateObject("Shell.Application") For Each objWin In objShell.Windows DoEvents If objWin.name = "Internet Explorer" Then If bExactMatch And title = objWin.LocationName Or Not bExactMatch And InStr(objWin.LocationName, title) > 0 Then Set getIEByTitle = objWin Exit Function End If End If Next If retryCnt = 0 Then Exit Function End If retryCnt = retryCnt - 1 Sleep 1000 GoTo RETRY_ End Function Public Sub waitIE(ie As InternetExplorer) On Error Resume Next Do While ie.Busy DoEvents Sleep 100 Loop Do While ie.document.readyState <> "complete" DoEvents Sleep 100 Loop End Sub Public Function getImageByAlt(ie As InternetExplorer, alt As String) As Object Dim img Set getImageByAlt = Nothing For Each img In ie.document.images DoEvents If img.alt = alt Then Set getImageBtAlt = img Exit Function End If Next End Function Public Function getLinkByInnerText(ie As InternetExplorer, innerText As String, Optional bExactMatch = True) As Object Dim link Dim frm Dim i Set getLinkByInnerText = Nothing For Each link In ie.document.links DoEvents If bExactMatch And innerText = trim(link.innerText) Or Not bExactMatch And InStr(trim(link.innerText), innerText) > 0 Then Set getLinkByInnerText = link Exit Function End If Next For i = 0 To ie.document.frames.Length - 1 Set frm = ie.document.frames(i) For Each link In frm.document.links DoEvents If bExactMatch And innerText = trim(link.innerText) Or Not bExactMatch And InStr(trim(link.innerText), innerText) > 0 Then Set getLinkByInnerText = link Exit Function End If Next Next End Function Public Sub DevNetSearch() Dim cel As Range Dim id As String Dim ie As InternetExplorer Set cel = ActiveCell id = getID(cel) Call searchID(id) Set ie = getProcenter() Call BringWindowToTop(ie.hWnd) End Sub public Function colName(col As Integer) As String colName = Split(Cells(1, col).Address, "$")(1) End Function Public Function colNum(name As String) As Intger colNum = Columns(name).Column End Function |
投稿 >