- ©«¤l
- 2
- ¥DÃD
- 1
- ºëµØ
- 0
- ¿n¤À
- 4
- ÂI¦W
- 0
- §@·~¨t²Î
- WIN XP
- ³nÅ骩¥»
- Office 2007
- ¾\ŪÅv
- 10
- ©Ê§O
- ¨k
- µù¥U®É¶¡
- 2011-1-20
- ³Ì«áµn¿ý
- 2018-9-8
|
VBA¦p¦óÃö³¬ºô¶´£¥Ü
§Ú¥ÎVBA«÷´ê§ï¼g¤F¥H¤Uµ{¦¡½X¡A¥i¥H¤U¸ü¡A¦ý¬O·íºô¶¥X²{¬dµL¸ê®Æ®É¡A¸õ¥Xºô¶´£¥Ü¡A½Ð°Ý¦p¦óÃö³¬ºô¶´£¥Ü
Option Explicit
Public eachcode(20000) As String
Public DataDate() As String
Sub Query()
Dim objIE As InternetExplorer
Dim objDoc As HTMLDocument
Dim objTable As HTMLTable
Dim objRow As HTMLTableRow
Dim strURL As String
Dim i As Integer, j As Integer, m As Integer, n As Integer, ri As Integer, rj As Integer
Dim NumDate As Integer
Dim Fn As String
Dim A1() As String
Dim InputStr, S3, vfname As String
Dim vdata As Variant
Dim arows, acols As Long
Fn = FreeFile
Open ActiveWorkbook.Path & "\" & "stockcode.txt" For Input As #Fn '¶}±Ò stockcode.txt ÀÉ
Application.ScreenUpdating = False 'µe±¼È°±§ó·s
m = 0
While Not EOF(Fn)
Line Input #Fn, InputStr '±qÀÉ®×Ū¥X¤@¦C,
If Len(InputStr) > 0 Then '²¤¹LµL¦r¦êªºªÅ¦æ
eachcode(m) = Trim(InputStr)
'§âŪ¤Jªº¤å¦r¦C¸m©ó eachcode °}¦C¸Ì
End If
m = m + 1
Wend
Application.ScreenUpdating = True 'µe±«ì´_§ó·s
Close #Fn
strURL = "http://www.tdcc.com.tw/smWeb/QryStock.jsp"
Set objIE = New InternetExplorer
With objIE
.Navigate strURL
' .Visible = True
Do While .Busy Or .ReadyState <> READYSTATE_COMPLETE
DoEvents
Loop
Set objDoc = .Document
End With
NumDate = objDoc.getElementsByName("SCA_DATE").Item.Length
ReDim DataDate(NumDate - 1)
For i = 0 To NumDate - 1
DataDate(i) = objDoc.getElementsByName("SCA_DATE").Item.Item(i).innerText
Next
S3 = ""
ChDir ActiveWorkbook.Path & "\"
On Error Resume Next '
For n = 0 To m - 1
Application.Windows(ThisWorkbook.Name).Activate
'Sheet1.Activate
Cells.Select
Selection.Clear
Cells(1, 1) = eachcode(n)
For i = 0 To NumDate - 1
With objDoc
.getElementsByName("StockNo").Item.Value = eachcode(n)
.getElementsByName("SCA_DATE").Item.selectedIndex = i
.getElementsByName("sub").Item.Click
End With
Application.Wait Now + TimeSerial(0, 0, 3)
Application.ScreenUpdating = False
Set objTable = objDoc.getElementsByTagName("TABLE").Item(7)
For ri = 0 To objTable.Rows.Length - 1
Set objRow = objTable.Rows(ri)
For rj = 0 To objRow.Cells.Length - 1
Cells(3 + 20 * i + ri, 1 + rj) = objRow.Cells(rj).innerText
Next
Next
'Range(Cells(1 + 20 * i, 1), Cells(1 + 20 * i, 5)).EntireColumn.AutoFit
Cells(1 + 20 * i, 2) = objDoc.getElementsByTagName("TABLE").Item(5).innerText
Cells(1 + 20 * i, 5) = objDoc.getElementsByTagName("TABLE").Item(6).innerText
Application.ScreenUpdating = True
Next
ActiveSheet.UsedRange.Select
arows = Selection.Rows.Count
acols = Selection.Columns.Count
vfname = eachcode(n) + ".csv"
Open vfname For Output As #1 '©w¸qOutput File¦ì¸m
For i = 1 To arows
For j = 1 To acols - 1
vdata = Selection.Cells(i, j).Text
vdata = Replace(vdata, ",", "")
Write #1, vdata;
Next j
Write #1, Selection.Cells(i, acols).Text
Next i
Close #1
Next
objIE.Quit
Set objRow = Nothing
Set objTable = Nothing
Set objDoc = Nothing
Set objIE = Nothing
End Sub |
-
-
¬d¸ß.zip
(17.7 KB)
|