GBKEE

¦^´_ 1# torrent

1. Option Explicit
   
2. Sub Ex()
   
3.     Dim I As Integer, Rng As Range
   
4.     With ActiveSheet                                        '¤u§@ªí¤¤ [AÄæ] ¦³¨Æ·~½s¸¹
   
5.         Set Rng = .[A2]                                     '±qA2¶}©lŪ¨ú
   
6.         Application.DisplayAlerts = False                   'Ãö³¬À³¥Îµ{¦¡ªº¸ß°Ý
   
7.         Do While Rng <> ""                                  'ª½¨ìAÄæ¨S¸ê®Æ
   
8.             With Workbooks.Add(1)                           '·s¼W¬¡­¶Ã¯
   
9.                 With .Sheets(1).QueryTables.Add(Connection:="URL;http://prtr.epa.gov.tw/resultEMS.aspx?emsno=" & Rng & "&tab=Panel1", _
   
10.                     Destination:=[A1])                      '¤u§@ªí·s¼W,¶×¤J¥~³¡¬d¸ß.
    
11.                     .WebSelectionType = xlSpecifiedTables
    
12.                     .WebFormatting = xlWebFormattingNone
    
13.                     .WebTables = "6,""GridView3"""
    
14.                     .WebPreFormattedTextToColumns = True
    
15.                     .WebConsecutiveDelimitersAsOne = True
    
16.                     .WebSingleBlockTextImport = False
    
17.                     .WebDisableDateRecognition = False
    
18.                     .WebDisableRedirections = False
    
19.                     .Refresh BackgroundQuery:=False
    
20.                     .Parent.Names(.Name).Delete
    
21.                     .Delete
    
22.                 End With
    
23.                 .SaveAs ThisWorkbook.Path & "\" & Rng   '¦sÀɸê®Æ§¨¦WºÙ
    
24.                 ' .Close                                'Ãö³¬ÀÉ®×
    
25.             End With
    
26.             Set Rng = Rng.Offset(1)                     '¤U²¾¤@¦C
    
27.         Loop
    
28.         Application.DisplayAlerts = True                '«ì´_À³¥Îµ{¦¡ªº¸ß°Ý
    
29.     End With
    
30. End Sub

½Æ»s¥N½X