Private Declare Function SetForegroundWindow Lib "user32" _

(ByVal hWnd As Long) As Long

Private Declare Function IsIconic Lib "user32" _

(ByVal hWnd As Long) As Long

Private Declare Function ShowWindowAsync Lib "user32" _

(ByVal hWnd As Long, ByVal nCmdShow As Long) As Long

 

Sub web1()

Dim myobj As Object, objIE As Object

Dim fff As String, mycnt

 

Set myobj = CreateObject("Shell.Application")

    mycnt = myobj.Windows.Count

 

fff = "http://www2s.biglobe.ne.jp/~iryo/"

'fff = """https://www.google.co.jp/?gws_rd=ssl""" 'VBAの記述時、?付きは""3個にする

 

With myobj.Windows

    Shell ("EXPLORER.EXE " & fff)

        Do

            DoEvents

        Loop Until mycnt + 1 <= .Count

    Set objIE = .Item(mycnt)

End With

 

   Do While objIE.ReadyState <> 4 Or objIE.Busy = True

        DoEvents

   Loop

 

    If IsIconic(objIE.hWnd) Then

       ShowWindowAsync objIE.hWnd, &H9

    End If

        SetForegroundWindow (objIE.hWnd)

Set objIE = Nothing

Set myobj = Nothing

End Sub

Sub web2()

・・・・・・・・・・・・・・・　以下Sub web1と同じ　・・・・・・・・・・・・・・・

 

With objIE

        .StatusBar = 1

        .Toolbar = 1

        .AddressBar = 1

        .Width = 600

        .Height = 400

        .Left = 0

        .Top = 0

    End With

 

Set objIE = Nothing

Set myobj = Nothing

End Sub

Sub web3()

Dim myobj As Object, objIE As Object

Dim fff As String, mycnt

 

Set myobj = CreateObject("Shell.Application")

mycnt = myobj.Windows.Count

 

fff = "http://www2s.biglobe.ne.jp/~iryo/"

With myobj.Windows

      .Item(mycnt - 1).Navigate2 fff

   Do Until Not .Item(mycnt) Is Nothing

     DoEvents

   Loop

   Set objIE = .Item(mycnt)

End With

 

   Do While objIE.ReadyState <> 4 Or objIE.Busy = True

        DoEvents

   Loop

 Application.Wait (Now + TimeValue("0:00:05"))

 

    dat1 = objIE.Document.URL

    dat2 = objIE.Document.Title

    dat3 = objIE.Path

    dat4 = objIE.Name

    dat5 = objIE.FullName

 

    dat6 = TypeName(objIE.Document)

    dat7 = objIE.locationName

    dat8 = objIE.locationURL

 

msg = "(1)objIE.Document.URLh→" & dat1 & Chr(10) & _

(2)objIE.Document.Title→ & dat2 & Chr(10) & _

(3)objIE.Path→ & dat3 & Chr(10) & _

(4)objIE.Name→ & dat4 & Chr(10) & _

(5)objIE.FullName→ & dat5 & Chr(10) & _

(6)TypeName(objIE.document)→ & dat6 & Chr(10) & _

(7)objIE.locationName→ & dat7 & Chr(10) & _

(8)objIE.locationURL→ & dat8

 

objIE.Quit

Set myobj = Nothing

 MsgBox msg

End Sub

Sub taWeb1()

 

    Workbooks.Open Filename:="http://www2s.biglobe.ne.jp/~iryo/"

End Sub

Sub taWeb2()

Application.ScreenUpdating = False

Workbooks.Open Filename:=fff

Dim zu As Object

 For Each zu In ActiveSheet.Shapes

        zu.Delete

 Next

Cells.Select

    Selection.Interior.ColorIndex = xlNone

    Range("C16").Select

Dim myobj As Hyperlink

    For Each myobj In ActiveSheet.Hyperlinks

        With myobj

            myobj.Delete

        End With

    Next

Dim endr As Integer, i As Integer

ActiveSheet.Cells.SpecialCells(xlLastCell).Select

        endr = ActiveCell.Row

    For i = endr To 1 Step -1

        If IsNumeric(Cells(i, 1)) = False Or Cells(i, 1) = "" Then

            Rows(i).Select

            Selection.Delete Shift:=xlUp

        End If

    Next

 

   Columns("D:H").Select

    Selection.Delete Shift:=xlToLeft

    Columns("B:B").Select

    Selection.Delete Shift:=xlToLeft

    Range("A1").Select

データを別ブックにコピー

 Columns("A:B").Select

    Selection.Copy

Application.DisplayAlerts = False

    ActiveWorkbook.Saved = True

    ActiveWorkbook.Close

Application.DisplayAlerts = False

 

ThisWorkbook.Sheets("IEWeb2_1").Select

Range("A1").Select

   ActiveSheet.Paste

Range("A1").Select

End Sub

Sub taWeb3()

Dim myxls As String

    myxls = "http://www2s.biglobe.ne.jp/~iryo/"

With CreateObject("Excel.Application")

    .Visible = True

    .Workbooks.Open (myxls)

End With

End Sub

Sub taWeb4()

With ThisWorkbook.Sheets("IEWeb")

    .Hyperlinks.Add(Anchor:=.Range("A1"), Address:= _

        "http://www2s.biglobe.ne.jp/~iryo/", TextToDisplay:="IEWeb2").Follow

    .Range("A1") = ""

End With

End Sub

Sub taWeb5()

 

    Shell "EXPLORER.EXE http://www2s.biglobe.ne.jp/~iryo/"

End Sub

Sub taWeb6XP()

Dim objIE As Object

Set objIE = CreateObject("InternetExplorer.Application")

    objIE.Navigate "http://www2s.biglobe.ne.jp/~iryo/"

    objIE.Visible = True

 

Do While objIE.Busy = True

    DoEvents

Loop

Set objIE = Nothing

End Sub

Sub taWeb7XP()

Dim objIE

Dim objShell

Dim objWin

Dim obcnt

Dim fff As String

 

fff = ThisWorkbook.Path & "\form01.html"

Set objShell = CreateObject("Shell.Application")

obcnt = 0

For Each objWin In objShell.Windows

    obcnt = obcnt + 1

Next

 

With objShell.Windows

     If obcnt = 0 Then

        .Item.Navigate2 fff

        obcnt = obcnt + 1

     Else

        .Item(obcnt - 1).Navigate2 fff, &H800

     End If

 

     'オブジェクトが確定するまでの空ループ

     Do Until Not .Item(obcnt) Is Nothing

        DoEvents

     Loop

 

     Set objIE = .Item(obcnt)

End With

 

With objIE.Document

    .all("txt1").Value = "text(1)へ記入　12345"

    .all.txt2.Value = "text(2)へ記入　abcde"

    .Myfm.txt3.Value = "text(3)へ記入　ABCDE"

 

    .getElementById("txt4").Value = "text(4)へ記入　あいうえお"

    .forms(1).elements(1).Value = "text(5)へ記入　67890"

End With

 

Set objIE = Nothing

Set objShell = Nothing

 

End Sub

Sub taWeb7()

Dim objWshShell As Object

    Set objWshShell = CreateObject("WScript.Shell")

    objWshShell.Run "http://www2s.biglobe.ne.jp/~iryo/index.html", 1

 

End Sub