ªð¦^¦Cªí ¤W¤@¥DÃD µo©«

[µo°Ý] ¥i§_¥Î°j°é©ÎÅܼƶפJ¤j¶q¸ê®Æ¡H

¦^´_ 50# smart3135


   
¦ý¦b¶]¨ì .ParentNode.submit·|¥X²{¨S¦³¨Ï¥ÎÅv­­¡A¦]¬°¤£À´³o¬qµ{¦¡½Xªº·N«ä¡A¯à½Ð±z¦AÀ°¦£¤@¤U¶Ü¡H
§Æ±æµ²ªG¬°
103¦~4¤ë
103¦~3¤ë
103¦~2¤ë
103¦~1¤ë
¤W¥«,¤WÂdªººô­¶«Ø¸m¤£¤@¼Ë
¸Õ¸Õ¬Ý
  1. Option Explicit
  2. Dim IE As Object
  3. Sub IE_Application()
  4.     Set IE = CreateObject("InternetExplorer.Application")
  5.     With IE
  6.         .Navigate "http://www.twse.com.tw/ch/trading/exchange/FMSRFK/FMSRFKMAIN.php"
  7.         .Visible = True   '¤£Åã¥Üie
  8.         Do While .Busy Or .readyState <> 4: DoEvents: Loop
  9.   End With
  10. End Sub
  11. Sub ¤W¥«¤ë¦¨¥æ¸ê°T()
  12.     Dim Rng As Range, Rng1 As Range, E As Range, X As Range, T As Date, xPath As String, xFile As String
  13.     Dim Ea As Variant, ar(), ii As Integer
  14.     T = Time
  15.     Application.DisplayStatusBar = True
  16.     '½Ð±N¤WÂdªºªÑ²¼¥N¸¹,¦b Sheets(3).Range("A1")©¹¤UKey¤W,°j°é¨Ì³o¸ÌªºªÑ²¼¥N¸¹¶×¤J
  17.     Set Rng = ThisWorkbook.Sheets(3).Range("A:A")
  18.     Set Rng1 = ThisWorkbook.Sheets(3).Range("b:b")
  19.     If Application.Count(Rng) = 0 Then MsgBox "¨S¦³ªÑ²¼¥N¸¹": Exit Sub
  20.     If Application.Count(Rng1) = 0 Then MsgBox "¨S¦³ªÑ²¼¥N¸¹": Exit Sub
  21.     Set Rng = Rng.SpecialCells(xlCellTypeConstants)
  22.     Set Rng1 = Rng1.SpecialCells(xlCellTypeConstants)
  23.     xPath = "D:\°]³ø¸ê®Æ"
  24.     IE_Application    '
  25.     Application.StatusBar = " "
  26.     For Each E In Rng
  27.         With Sheets(1)
  28.             .Activate
  29.             .Cells.Clear  '¤U¸ü¸ê®Æ¸m©ó¦¹¤u§@ªí,ÅÜ´«ªÑ²¼®É:²MªÅ
  30.         End With
  31.         For Each X In Rng1
  32.             With IE
  33.                 .Document.getElementsByTagName("select")("myear").Value = X
  34.                  With .Document.getelementbyid("STK_NO")
  35.                     .Value = E
  36.                     .Document.getelementSbyNAME("login_btn")(0).Click  '«ö¤U¬d¸ß
  37.                 End With
  38.                 Do While .Busy Or .readyState <> 4:    Loop
  39.                 Ep .Document.getElementsByTagName("TABLE")(7).outerHTML
  40.             End With
  41.         Next X
  42.         xFile = xPath & "\" & E & "\HPM.txt"
  43.         MkDir_Sub xFile
  44.         Maketxt xFile, Sheets(1).Range("A1").CurrentRegion, E.Value
  45.         ii = ii + 1
  46.         Application.StatusBar = Application.Text(Time - T, ["MM¤ÀSS¬í"]) & " ¦@¶×¤J¤WÂd¤ë¦¨¥æ " & ii & " ¤å¦rÀÉ"
  47.     Next E
  48.     IE.Quit
  49.     Application.StatusBar = Application.Text(Time - T, ["MM¤ÀSS¬í"]) & " ¦@¶×¤J¤WÂd¤ë¦¨¥æ " & ii & " ¤å¦rÀÉ,  Åª¨ú§¹²¦ !! "
  50.     MsgBox "¶×¤J ¤å¦rÀÉ" & ii & " ¶O®É " & Application.Text(Time - T, ["MM¤ÀSS¬í"])
  51.     ThisWorkbook.Save
  52. End Sub
  53. Sub Ep(S As String)
  54.     Dim D As New DataObject, i As Integer, FormDLL As String, Rng As Range
  55.     'DataObject ª«¥ó ¦b¶i¦æÂà´«°Ê§@®É¡A°µ¬°®æ¦¡¤Æ¤å¦r¸ê®Æªº¼È¦s°Ï°ì¡C¨ä¤]¥i¥H¼È¦s©MÀx¦s¦b DataObject ªº¤å¦r¤ù¬q¬ÛÃöªº®æ¦¡¡C
  56.     '«Å§i Dim D As New DataObject '¶·¦b¤u¨ã-> ³]©w¤Þ¥Î¶µ¥Ø¥[¤J ·s¼W¤Þ¥Î Microsoft Forms 2.0 Object Library ,±M®× ¥[¤J¤@ªí³æ§Y¥i
  57.     On Error GoTo ER
  58.     With D
  59.         .SetText S
  60.         .PutInClipboard
  61.         With Sheets(1)
  62.             With .Range("a" & .Rows.Count).End(xlUp)
  63.                 If .Row = 1 Then
  64.                     Set Rng = .Cells
  65.                 Else
  66.                     Set Rng = .Offset(1)
  67.                 End If
  68.                 Rng.Select
  69.                 .Parent.PasteSpecial Format:="Unicode ¤å¦r"
  70.                 Set Rng = Rng.Range("A3", Rng.Range("A3").End(xlDown)).Resize(, 9)
  71.                 'Sort :¸ê®Æ±Æ§Ç
  72.                 Rng.Sort Key1:=Rng.Range("B2"), Order1:=xlDescending, Header:=xlYes ', _
  73.                 OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, SortMethod _
  74.                 :=xlStroke, DataOption1:=xlSortNorma
  75.                 If .Row = 1 Then
  76.                     .Range("A2").EntireRow.Delete
  77.                 Else
  78.                     .Range("A2:A4").EntireRow.Delete
  79.                 End If
  80.             End With
  81.         End With
  82.     End With
  83.     Exit Sub
  84. ER:
  85.     ThisWorkbook.VBProject.References.AddFromFile "C:\windows\system32\FM20.DLL"
  86.     Resume
  87. End Sub
  88. Sub Maketxt(xF As String, Q As Range, Code As String)     '±N¶×¤J¸ê®Æ¦s¤J«ü©wªºtxt
  89.     Dim fs As Object, E As Range, C As Variant
  90.     Set fs = CreateObject("Scripting.FileSystemObject")
  91.     Set fs = fs.CreateTextFile(xF, True)  '³Ð¨£¤@­ÓÀÉ®×,¦pÀɮצs¦b¥iÂл\±¼
  92.     Q.Cells(1) = Code & " ¤ë¦¨¥æ¸ê°T"   '¥[¤JªÑ²¼¥N¸¹
  93.     For Each E In Q.Rows
  94.         C = Application.Transpose(Application.Transpose(E.Value))
  95.         C = Join(C, vbTab)
  96.         fs.WriteLine C
  97.     Next
  98.     fs.Close
  99. End Sub
  100. Sub MkDir_Sub(S As String)
  101.     Dim ar, i As Integer, xPath As String
  102.     If Dir(S) = "" Then
  103.         ar = Split(S, "\")
  104.         xPath = ar(0)
  105.         For i = 1 To UBound(ar) - 1
  106.             xPath = xPath & "\" & ar(i)
  107.             If Dir(xPath, vbDirectory) = "" Then MkDir xPath
  108.         Next
  109.     End If
  110. End Sub
½Æ»s¥N½X
·P®¦ªº¤ß......(¦b³Â»¶®a±Ú°Q½×°Ï.¥Î¤ß¾Ç²ß·|¦³¶i¨Bªº)
¦ý¸ê·½µL­­,«á´©¦³­­,  ¤@¤Ñ1¤¸ªºÃÙ§U,¤H¤H¦³¯à¤O.

TOP

¦^´_ 51# GBKEE
·PÁÂGBKEEª©¥D¡A³o¨Çµ{¦¡½X¤SÅý§Ú¾Ç¨ì«Ü¦h¡A§Ú¤]¸ÕµÛ±N¤WÂd¸ê®Æ¦Û¦æ±Æ§Ç¡A¸Õ¤F³\¤[¡A²×©ó¦¨¥\¤F
¤£¹L³o­Ó¤W¥«¦b¼g¤J¤å¦rÀɪºµ{¦¡½X¤¤¦³¤@¨Ç¤£¤Ó¤F¸Ñ¡A·Q¦A¦V±z½Ð¯q¡G
1.©M¥«Âd¤£¦Pªº¦a¤è¬O¦h¤F¤@­ÓCode¡A¦Ó³o­ÓCode·|ª½±µ¥N¤JEªº¥N¸¹¡A·Q½Ð°Ý³o­ÓCode¬O¤°»ò¡H
2.¦b [Q.Cells(1) = Code & " ¤ë¦¨¥æ¸ê°T"   '¥[¤JªÑ²¼¥N¸¹]³o¬qµ{¦¡½Xªºµ²ªG·|Åܦ¨[ªÑ²¼¥N¸¹&¤ë¦¨¥æ¸ê°T]¡A¦]¬°§Ú·Q°£¤F³sªÑ²¼¥N¸¹¤§¥~¡A³sªÑ²¼¦WºÙ¤]¯àÅã¥Ü
Á|¨Ò¨Ó»¡¡G¶]²Ä¤@ÀɪѲ¼®Éµ²ªG·|¬O"1101¤ë¦¨¥æ¸ê°T"¡A§Ú·Q­nªºµ²ªG¬O"1101¨Èªd¤ë¦¨¥æ¸ê°T"¡A§Ú¦³¸ÕµÛ¥Î­ì¨ÓA1Àx¦s®æ«O¯dªº"103¦~1101¨Èªd¤ë¦¨¥æ¸ê°T"
¨Ó°µ­×§ï¡A¦³¥Îmid¨ç¼Æ¡A¤]¦³¥Îreplce¡A¨Ã±N[Q.Cells(1) = Code & " ¤ë¦¨¥æ¸ê°T"   '¥[¤JªÑ²¼¥N¸¹]¥Îµù¸Ñ¸õ¹L¡A¦ý¥u­n³o¬q¸õ¹L´N·|¦bfs.WriteLine C¥X¿ù
¦pªG¤£¸õ¹L¡A¦b³o¸Ì¥[¤J¨ä¥Lµ{¦¡½X¤@¼Ë·|¦bfs.WriteLine C¥X¿ù¡A¤£²M·¡¬°¦ó·|³o¼Ë¡H

­ì¨Óªºµ{¦¡½X
  1. Sub Maketxt(xF As String, Q As Range, Code As String)     '±N¶×¤J¸ê®Æ¦s¤J«ü©wªºtxt
  2.     Dim fs As Object, E As Range, C As Variant
  3.     Set fs = CreateObject("Scripting.FileSystemObject")
  4.     Set fs = fs.CreateTextFile(xF, True)  '³Ð¨£¤@­ÓÀÉ®×,¦pÀɮצs¦b¥iÂл\±¼
  5.     Q.Cells(1) = Code & " ¤ë¦¨¥æ¸ê°T"   '¥[¤JªÑ²¼¥N¸¹
  6.     For Each E In Q.Rows
  7.         C = Application.Transpose(Application.Transpose(E.Value))
  8.         C = Join(C, vbTab)
  9.         fs.WriteLine C
  10.     Next
  11.     fs.Close
  12. End Sub
½Æ»s¥N½X
§Ú¦Û¤v­×§ïªºµ{¦¡½X(·|¥X¿ù)
  1. Sub Maketxt(xF As String, Q As Range, Code As String)     '±N¶×¤J¸ê®Æ¦s¤J«ü©wªºtxt
  2.     Dim fs As Object, E As Range, C As Variant, A As String, B As String
  3.     Set fs = CreateObject("Scripting.FileSystemObject")
  4.     Set fs = fs.CreateTextFile(xF, True)  '³Ð¨£¤@­ÓÀÉ®×,¦pÀɮצs¦b¥iÂл\±¼
  5.     A = Q.Cells(1)
  6.     B = Mid(A, 5, 15)
  7.     Q.Cells(1) = B
  8. '    Q.Cells(1) = Code & " ¤ë¦¨¥æ¸ê°T"   '¥[¤JªÑ²¼¥N¸¹
  9.     For Each E In Q.Rows
  10.         C = Application.Transpose(Application.Transpose(E.Value))
  11.         C = Join(C, vbTab)
  12.         fs.WriteLine C
  13.     Next
  14.     fs.Close
  15. End Sub
½Æ»s¥N½X

TOP

¦^´_ 52# smart3135
Q.Cells(1) ¦³¤£¥i¨£¦r¤¸¦p¹Ï,·|³y¦¨µ{¦¡½Xªº¿ù»~,©Ò¥HÅܳq¤@¤U
  1. Q.Cells(1) = Code & " ¤ë¦¨¥æ¸ê°T"   '¥[¤JªÑ²¼¥N¸¹
½Æ»s¥N½X
·P®¦ªº¤ß......(¦b³Â»¶®a±Ú°Q½×°Ï.¥Î¤ß¾Ç²ß·|¦³¶i¨Bªº)
¦ý¸ê·½µL­­,«á´©¦³­­,  ¤@¤Ñ1¤¸ªºÃÙ§U,¤H¤H¦³¯à¤O.

TOP

¦^´_ 53# GBKEE
ª©¥D±z¦n¡A¤£¦n·N«ä¡A½Ð°Ý¤@¤U¥[¤Fa=Q.Cells(1)¦³¤°»ò¤£¦P©O?ÁöµM°õ¦æ®É¤£·|¥X¿ù¡A¤£¹Lµ²ªGÁÙ¬O¨SÅÜ¡A¦]¬°°õ¦æ¨ì¤U­±¡A¿é¥Xªºµ²ªGÁÙ¬OQ.Cells(1) = Code & "¤ë¦¨¥æ¸ê°T"
§Ú¸ÕµÛ¦A­×§ï¤F¤@¤U¡A¤£¹LÁÙ¬O¦p¤§«e·|¥X¿ù¡A¤£ª¾±z»¡ªºÅܳq¬O«ü¡H¡H¡H¡H¡H
  1. Sub Maketxt(xF As String, Q As Range, Code As String)     '±N¶×¤J¸ê®Æ¦s¤J«ü©wªºtxt
  2.     Dim fs As Object, E As Range, C As Variant
  3.     Dim A As String, B As String
  4.     A = Q.Cells(1)
  5. '    B = Mid(A, 9, 20)¡@¡@'³o¬qµ{¦¡½X¥[¤Jªº¸Ü´N·|¥X¿ù,¥Îµù¸Ñ¸õ¹L«h¤£·|¥X¿ù,¦ý³o¬qµ{¦¡½X¬O­nÂ^¨ú¥¿½T¤å¦r
  6.     Set fs = CreateObject("Scripting.FileSystemObject")
  7.     Set fs = fs.CreateTextFile(xF, True)  '³Ð¨£¤@­ÓÀÉ®×,¦pÀɮצs¦b¥iÂл\±¼
  8.     Q.Cells(1) = Code & B   '¥[¤JªÑ²¼¥N¸¹
  9.     For Each E In Q.Rows
  10.         C = Application.Transpose(Application.Transpose(E.Value))
  11.         C = Join(C, vbTab)
  12.         fs.WriteLine C
  13.     Next
  14.     fs.Close
  15. End Sub
½Æ»s¥N½X

TOP

¦^´_ 51# GBKEE
¤£¦n·N«ä¡AGBKEEª©¥D¡A¤Sµo²{¤@­Ó¤ñ¸û¤jªº°ÝÃD¤F¡A§Ú·Q­nªº¸ê®Æ¬Oªñ¤T¦~ªº¤ë¦¨¥æ¸ê®Æ¡A¥i¬O¦³¨Ç­ÓªÑ¬Oªñ1-2¦~¤~¤W¥«Âdªº¡A©Ò¥H¦b¤W¥«ºô­¶¿é¤J®É·|¥X²{¬dµL
¦Ó¦b¤WÂdºô­¶«h¬O¥u·|¥X²{¤WÂd«á¶}©lªº¤ë¦¨¥æ¸ê®Æ¡A·í¬d¨ì¤W¥«Âd«eªº¦~¥÷´N·|¥X²{¬dµL¡A¦pªGÅýVBAª½±µ°õ¦æªº¸Ü¡A°õ¦æ¨ì¤W¥«Âd¤£¨ì¤T¦~ªº­ÓªÑ¥N¸¹´N·|¥X¿ù
ÁÙ·|¦³µL½a°j°éªºª¬ªp¡A¤£ª¾¹D¦³¨S¦³¿ìªk¥[¤J¨ä¥Lµ{¦¡½X¨ÓÁקK³oºØ¿ù»~¡H
Á|¨Ò¨Ó»¡¡G¦pªG­ÓªÑ¥u¦³¤W¥«Âd¤£¨ì¤@¦~¡B©Î¤@¦~¨ì¨â¦~¡A¯à¤£¯à¥uÂ^¨ú¸Ó­ÓªÑ¦³ªº¸ê®Æ¡A·í¹J¨ì¬dµLªº¦~¥÷´Nµ²§ô¸Ó­ÓªÑªº¸ê®ÆÂ^¨ú¡A¸õ¨ì¤U¤@­ÓªÑ
ªþ¥ó¬O§Ú±NSheet(3)¥N¤J¤@¨Ç¤W¥«Âd¤£¨ì¤T¦~ªº­ÓªÑ¥N¸¹·|¥X¿ùªºEXCEL¡A¦A½Ð±z«ü¾É¤@¤U¡AÁÂÁ¡I

¤W¥«Âd¤ë¦¨¥æ¸ê°T.zip (37.25 KB)

TOP

¦^´_ 55# smart3135


   
¥[¤Fa=Q.Cells(1)¦³¤°»ò¤£¦P©O?ÁöµM°õ¦æ®É¤£·|¥X¿ù¡A¤£¹Lµ²ªGÁÙ¬O¨SÅÜ¡A

¥[¤Fa=Q.Cells(1),¥u¬O¬°¤FÅã¥Ü©ó¹Ï¥Ü:°Ï°ìÅܼƵøµ¡¤¤ªº¤£¥i¨£¦r¤¸
  1. Sub ¤W¥«¤ë¦¨¥æ¸ê°T()
  2.     Dim Rng As Range, Rng1 As Range, E As Range, X As Range, T As Date, xPath As String, xFile As String
  3.     Dim Ea As Variant, ar(), ii As Integer
  4.     T = Time
  5.     Application.DisplayStatusBar = True
  6.     '½Ð±N¤WÂdªºªÑ²¼¥N¸¹,¦b Sheets(3).Range("A1")©¹¤UKey¤W,°j°é¨Ì³o¸ÌªºªÑ²¼¥N¸¹¶×¤J
  7.     Set Rng = ThisWorkbook.Sheets(3).Range("A:A")
  8.     Set Rng1 = ThisWorkbook.Sheets(3).Range("b:b")
  9.     If Application.Count(Rng) = 0 Then MsgBox "¨S¦³ªÑ²¼¥N¸¹": Exit Sub
  10.     If Application.Count(Rng1) = 0 Then MsgBox "¨S¦³ªÑ²¼¥N¸¹": Exit Sub
  11.     Set Rng = Rng.SpecialCells(xlCellTypeConstants)
  12.     Set Rng1 = Rng1.SpecialCells(xlCellTypeConstants)
  13.     xPath = "D:\°]³ø¸ê®Æ"
  14.     IE_Application    '
  15.     Application.StatusBar = " "
  16.     For Each E In Rng
  17.         With Sheets(1)
  18.             .Activate
  19.             .Cells.Clear  '¤U¸ü¸ê®Æ¸m©ó¦¹¤u§@ªí,ÅÜ´«ªÑ²¼®É:²MªÅ
  20.         End With
  21.         For Each X In Rng1
  22.             With IE
  23.                 .Document.getElementsByTagName("select")("myear").Value = X
  24.                  With .Document.getelementbyid("STK_NO")
  25.                     .Value = E
  26.                     .Document.getelementSbyNAME("login_btn")(0).Click  '«ö¤U¬d¸ß
  27.                 End With
  28.                 Do While .Busy Or .readyState <> 4:    Loop
  29.                 If .Document.getElementsByTagName("TABLE")(7).Rows.Length > 1 Then
  30.                     Ep .Document.getElementsByTagName("TABLE")(7).outerHTML
  31.                 Else
  32.                     GoTo Nn
  33.                 End If
  34.             End With
  35.         Next X
  36. Nn:
  37.         xFile = xPath & "\" & E & "\HPM.txt"
  38.         MkDir_Sub xFile
  39.         Maketxt xFile, Sheets(1).Range("A1").CurrentRegion, E.Value
  40.         ii = ii + 1
  41.         Application.StatusBar = Application.Text(Time - T, ["MM¤ÀSS¬í"]) & " ¦@¶×¤J¤WÂd¤ë¦¨¥æ " & ii & " ¤å¦rÀÉ"
  42.     Next E
  43.     IE.Quit
  44.     Application.StatusBar = Application.Text(Time - T, ["MM¤ÀSS¬í"]) & " ¦@¶×¤J¤WÂd¤ë¦¨¥æ " & ii & " ¤å¦rÀÉ,  Åª¨ú§¹²¦ !! "
  45.     MsgBox "¶×¤J ¤å¦rÀÉ" & ii & " ¶O®É " & Application.Text(Time - T, ["MM¤ÀSS¬í"])
  46. '    ThisWorkbook.Save
  47. End Sub
½Æ»s¥N½X
  1. Option Explicit
  2. Dim IE As Object
  3. Sub IE_Application()
  4.     If Not IE Is Nothing Then IE.Quit  '·í¬d¨ì¤WÂdªº¦~¥÷´N·|¥X²{¬dµL,¦¹IEµLªk¦A«×¬d¸ß,Ãö³¬¥¦
  5.     Set IE = CreateObject("InternetExplorer.Application")
  6.     With IE
  7.         .Navigate "http://www.gretai.org.tw/ch/stock/statistics/monthly/st44.php"
  8.         .Visible = True   '¤£Åã¥Üie
  9.         Do While .Busy Or .readyState <> 4: DoEvents: Loop
  10.     End With
  11. End Sub
  12. Sub ¤WÂd¤ë¦¨¥æ¸ê°T()
  13.     Dim Rng As Range, Rng1 As Range, E As Range, X As Range, T As Date, xPath As String, xFile As String
  14.     Dim Ea As Variant, AR(), ii As Integer, Msg As Boolean
  15.     T = Time
  16.     Application.DisplayStatusBar = True
  17.     '½Ð±N¤WÂdªºªÑ²¼¥N¸¹,¦b Sheets(3).Range("A1")©¹¤UKey¤W,°j°é¨Ì³o¸ÌªºªÑ²¼¥N¸¹¶×¤J
  18.     Set Rng = ThisWorkbook.Sheets(3).Range("A:A")
  19.     Set Rng1 = ThisWorkbook.Sheets(3).Range("b:b")
  20.     If Application.Count(Rng) = 0 Then MsgBox "¨S¦³ªÑ²¼¥N¸¹": Exit Sub
  21.     If Application.Count(Rng1) = 0 Then MsgBox "¨S¦³ªÑ²¼¥N¸¹": Exit Sub
  22.     Set Rng = Rng.SpecialCells(xlCellTypeConstants)
  23.     Set Rng1 = Rng1.SpecialCells(xlCellTypeConstants)
  24.     xPath = "D:\°]³ø¸ê®Æ"
  25.     Application.StatusBar = " "
  26.     For Each E In Rng
  27.         If Msg = False Then IE_Application   '·í¬d¨ì¤WÂdªº¦~¥÷´N·|¥X²{¬dµL,­«¶}IE
  28.         Sheets(1).UsedRange.Clear            '¤U¸ü¸ê®Æ¸m©ó¦¹¤u§@ªí,ÅÜ´«ªÑ²¼®É:²MªÅ
  29.         For Each X In Rng1
  30.             With IE
  31.                 .document.getElementsByTagName("select")("yy").Value = X
  32.                 Do While .Busy Or .readyState <> 4:    Loop
  33.                  With .document.getelementbyid("input_stock_code")
  34.                     .Value = E
  35.                     .ParentNode.submit
  36.                 End With
  37.                 Do While .Busy Or .readyState <> 4:    Loop
  38.                 If InStr(.document.getElementsByTagName("TABLE")(0).innerHTML, "¬dµL¸Óµ§¸ê®Æ") = 0 Then
  39.                     Msg = True
  40.                     If Application.Count(Sheets(1).UsedRange) = 0 Then '¦¹¤u§@ªí²MªÅ®É:¤U¸ü²Ä¤@¦~«×®É
  41.                         AR = Array(0, 2)
  42.                     Else
  43.                         AR = Array(2)
  44.                     End If
  45.                     For Each Ea In AR
  46.                         Ep .document.getElementsByTagName("TABLE")(Ea).outerHTML
  47.                     Next
  48.                 Else
  49.                     Msg = False          '¤WÂdªº¦~¥÷´N·|¥X²{¬dµL
  50.                     GoTo NN
  51.                 End If
  52.             ii = ii + 1
  53.             End With
  54.         Next X
  55. NN:
  56.         xFile = xPath & "\" & E & "\HPM.txt"
  57.         MkDir_Sub xFile
  58.         Maketxt xFile, Sheets(1).UsedRange
  59.         Application.StatusBar = Application.Text(Time - T, ["MM¤ÀSS¬í"]) & " ¦@¶×¤J¤WÂd¤ë¦¨¥æ " & ii / 3 & " ¤å¦rÀÉ"
  60.     Next E
  61.     IE.Quit
  62.     Application.StatusBar = Application.Text(Time - T, ["MM¤ÀSS¬í"]) & " ¦@¶×¤J¤WÂd¤ë¦¨¥æ " & ii / 3 & " ¤å¦rÀÉ,  Åª¨ú§¹²¦ !! "
  63.     MsgBox "¶×¤J ¤å¦rÀÉ" & ii & " ¶O®É " & Application.Text(Time - T, ["MM¤ÀSS¬í"])
  64. End Sub
  65. Sub Maketxt(xF As String, Q As Range)    '±N¶×¤J¸ê®Æ¦s¤J«ü©wªºtxt
  66.     Dim fs As Object, E As Range, C As Variant
  67.     Q.Range("C1") = ""
  68.     Q.Range("A1") = Q.Range("B1") & " " & "¤ë¦¨¥æ¸ê®Æ"
  69.     Q.Range("B1") = ""
  70.     Q.Range("a4", Q.Range("a4").End(xlDown)).Replace "¦~", ""
  71.     Q.Columns(1).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
  72.     Q.Rows(3).Delete     '¤WÂd¤ë¦¨¥æ¸ê®Æ·í¤ëÁÙ¥¼µ²§ô®É´N·|¦³¸ê®Æ¤F,©Ò¥H­n±NÁÙ¨Sµ²§ôªº¤ë¥÷§R°£
  73.     '¬OQ.Rows(3)¤£ Rows(4)
  74.     Set fs = CreateObject("Scripting.FileSystemObject")
  75.     Set fs = fs.CreateTextFile(xF, True)  '³Ð¨£¤@­ÓÀÉ®×,¦pÀɮצs¦b¥iÂл\±¼
  76.     For Each E In Q.Rows
  77.         C = Application.Transpose(Application.Transpose(E.Value))
  78.         C = Join(C, vbTab)
  79.         fs.WriteLine C
  80.     Next
  81.     fs.Close
  82. End Sub
½Æ»s¥N½X
·P®¦ªº¤ß......(¦b³Â»¶®a±Ú°Q½×°Ï.¥Î¤ß¾Ç²ß·|¦³¶i¨Bªº)
¦ý¸ê·½µL­­,«á´©¦³­­,  ¤@¤Ñ1¤¸ªºÃÙ§U,¤H¤H¦³¯à¤O.

TOP

¦^´_ 53# GBKEE
GBKEEª©¥D±z¦n¡A³o´X¤Ñ²×©ó§ËÀ´¤F¬°¤°»ò³o­Óµ{¦¡½X·|¥X¿ù¤F¡A­ì¨Ó±z»¡ªº¤£¥i¨£¦r¤¸¬O¢ß.Cells(1)¤å¦r¤¤¤º§tªº°Ý¸¹
§Ú¬OµÛ¥Î¥H¤U¤èªkÅý¥¦¤£·|¥X¿ù¡A¤]¯à¨ú±o­ÓªÑ¦WºÙ¤@°_¥N¤J¡A¤£¹L¤U­±ªº¤èªk¥u¯à¾A¥Î­ÓªÑ¦WºÙ¬O¨â­Ó¦rªº¡A¦pªG¹J¤W¤T­Ó¦rªºÁÙ¬O·|¥X¿ù
¤£ª¾¬O§_ÁÙ¦³¨ä¥LÅܳq¤è¦¡¡H¦A½Ð±z«üÂI¤@¤U¡AÁÂÁ¡I
¥t¥~ÁÙ·Q½Ð°Ý±zCode As StringªºCode¬O«ç»ò±a¥X­ÓªÑ½s¸¹ªº¡H¦]¬°§Ú¦b³o­Óµ{¦¡¤¤¦ü¥G§ä¤£¨ì©MCode¦³¬ÛÃöªºµ{¦¡½X¯à¨ú±o­ÓªÑ½s¸¹¡A¦A³Â·Ð±z¸Ñ´b¤@¤U¡AÁÂÁ¡I
  1. Sub Maketxt(xF As String, Q As Range, Code As String)     '±N¶×¤J¸ê®Æ¦s¤J«ü©wªºtxt
  2.     Dim fs As Object, E As Range, C As Variant, A As String, B As String
  3.     Set fs = CreateObject("Scripting.FileSystemObject")
  4.     Set fs = fs.CreateTextFile(xF, True)  '³Ð¨£¤@­ÓÀÉ®×,¦pÀɮצs¦b¥iÂл\±¼
  5.     A = Q.Cells(1)
  6.     B = Mid(A, 11, 2)
  7.     Q.Cells(1) = Code & B & " ¤ë¦¨¥æ¸ê°T"   '¥[¤JªÑ²¼¥N¸¹
  8.     For Each E In Q.Rows
  9.         C = Application.Transpose(Application.Transpose(E.Value))
  10.         C = Join(C, vbTab)
  11.         fs.WriteLine C
  12.     Next
  13.     fs.Close
  14. End Sub
½Æ»s¥N½X

TOP

¦^´_ 53# GBKEE
©êºp¡A§ó¥¿¤@¤U¡A¤W¤@½g¦^ÂЪº¤º®e¦³ÂI¿ù»~
¦pªG¹J¤W¤T­Ó¦rªºÁÙ¬O·|¥X¿ù§ï¦¨¦pªG¹J¤W¤T­Ó¦rªº­ÓªÑ¦WºÙ´N¥u¯àÂ^¨ú¨ì¨â­Ó¦r

TOP

¦^´_ 40# GBKEE
©êºp¡A¥ý«e¦³­Ó°ÝÃD¤@ª½§Ñ¤F°Ý±z¡A±z¦b40#¤¤¦^ÂЪºµ{¦¡½X½T¹ê¬O¥i¥H»s¹Ï¤Î¨ú±o¶°«O¤áªñ¤@¦~¸ê®Æ¡A¤£¹L©M§Ú·Q­nªº®æ¦¡¤£¤j¬Û¦P
¦b±z«á­±«ü¾É¦p¦ó§Q¥ÎÀ˵øºô­¶­ì©l½X¨ú±oÃöÁä¤Þ¼Æ«á¡A§Ú¦³¸ÕµÛ§Q¥Î¨ú±o¤W¥«¤ë¸ê®Æªºµ{¦¡½X±N¶°«O¤áºô­¶¤Î¬ÛÃö¤Þ¼Æ¥N¤J¡A¦ý¦b¤¤³~´N·|¥X¿ù
¤£¤j²M·¡°ÝÃD¥X¦b¤°»ò¦a¤è¡Aªþ¤Wµ{¦¡½X¥H¤Î§Ú·Q­n§¹¦¨ªº¤å¦rÀɮ榡¡A¦A³Â·Ð±z±Ð¾É¤@¤U¡A·PÁ¡I

¶°«O¤áºô­¶

  1. Option Explicit
  2. Dim IE As Object
  3. Sub IE_Application()
  4.     Set IE = CreateObject("InternetExplorer.Application")
  5.     With IE
  6.         .Navigate "http://www.tdcc.com.tw/smWeb/QryStock.jsp"
  7.         .Visible = True   '¤£Åã¥Üie
  8.         Do While .Busy Or .readyState <> 4: DoEvents: Loop
  9.   End With
  10. End Sub
  11. Sub ¶°«O()
  12.     Dim Rng As Range, Rng1 As Range, E As Range, X As Range, T As Date, xPath As String, xFile As String
  13.     Dim Ea As Variant, ar(), ii As Integer
  14.     T = Time
  15.     Application.DisplayStatusBar = True
  16.     '½Ð±N¤WÂdªºªÑ²¼¥N¸¹,¦b Sheets(3).Range("A1")©¹¤UKey¤W,°j°é¨Ì³o¸ÌªºªÑ²¼¥N¸¹¶×¤J
  17.     Set Rng = ThisWorkbook.Sheets(3).Range("A:A")
  18.     Set Rng1 = ThisWorkbook.Sheets(3).Range("b:b")
  19.     If Application.Count(Rng) = 0 Then MsgBox "¨S¦³ªÑ²¼¥N¸¹": Exit Sub
  20.     If Application.Count(Rng1) = 0 Then MsgBox "¨S¦³ªÑ²¼¥N¸¹": Exit Sub
  21.     Set Rng = Rng.SpecialCells(xlCellTypeConstants)
  22.     Set Rng1 = Rng1.SpecialCells(xlCellTypeConstants)
  23.     xPath = "D:\°]³ø¸ê®Æ"
  24.     IE_Application    '
  25.     Application.StatusBar = " "
  26.     For Each E In Rng
  27.         With Sheets(1)
  28.             .Activate
  29.             .Cells.Clear  '¤U¸ü¸ê®Æ¸m©ó¦¹¤u§@ªí,ÅÜ´«ªÑ²¼®É:²MªÅ
  30.         End With
  31.         For Each X In Rng1
  32.             With IE
  33.                 .Document.getElementsByTagName("select")("SCA_DATE").Value = X
  34.                  With .Document.getelementbyid("StockNo")
  35.                     .Value = E
  36.                     .Document.getelementSbyNAME("login_btn")(0).Click  '«ö¤U¬d¸ß
  37.                 End With
  38.                 Do While .Busy Or .readyState <> 4:    Loop
  39.                 If .Document.getElementsByTagName("TABLE")(7).Rows.Length > 1 Then
  40.                     Ep .Document.getElementsByTagName("TABLE")(7).outerHTML
  41.                 Else
  42.                     GoTo Nn
  43.                 End If
  44.             End With
  45.         Next X
  46. Nn:
  47.         xFile = xPath & "\" & E & "\SHD.txt"
  48.         MkDir_Sub xFile
  49.         Maketxt xFile, Sheets(1).Range("A1").CurrentRegion, E.Value
  50.         ii = ii + 1
  51.         Application.StatusBar = Application.Text(Time - T, ["MM¤ÀSS¬í"]) & " ¦@¶×¤J¤W¥«¤ë¦¨¥æ " & ii & " ¤å¦rÀÉ"
  52.     Next E
  53.     IE.Quit
  54.     Application.StatusBar = Application.Text(Time - T, ["MM¤ÀSS¬í"]) & " ¦@¶×¤J¤W¥«¤ë¦¨¥æ " & ii & " ¤å¦rÀÉ,  Åª¨ú§¹²¦ !! "
  55.     MsgBox "¶×¤J ¤å¦rÀÉ" & ii & " ¶O®É " & Application.Text(Time - T, ["MM¤ÀSS¬í"])
  56. '    ThisWorkbook.Save
  57. End Sub
  58. Sub Ep(S As String)
  59.     Dim D As New DataObject, i As Integer, FormDLL As String, Rng As Range
  60.     'DataObject ª«¥ó ¦b¶i¦æÂà´«°Ê§@®É¡A°µ¬°®æ¦¡¤Æ¤å¦r¸ê®Æªº¼È¦s°Ï°ì¡C¨ä¤]¥i¥H¼È¦s©MÀx¦s¦b DataObject ªº¤å¦r¤ù¬q¬ÛÃöªº®æ¦¡¡C
  61.     '«Å§i Dim D As New DataObject '¶·¦b¤u¨ã-> ³]©w¤Þ¥Î¶µ¥Ø¥[¤J ·s¼W¤Þ¥Î Microsoft Forms 2.0 Object Library ,±M®× ¥[¤J¤@ªí³æ§Y¥i
  62.     On Error GoTo ER
  63.     With D
  64.         .SetText S
  65.         .PutInClipboard
  66.         With Sheets(1)
  67.             With .Range("a" & .Rows.Count).End(xlUp)
  68.                 If .Row = 1 Then
  69.                     Set Rng = .Cells
  70.                 Else
  71.                     Set Rng = .Offset(1)
  72.                 End If
  73.                 Rng.Select
  74.                 .Parent.PasteSpecial Format:="Unicode ¤å¦r"
  75.                 Set Rng = Rng.Range("A3", Rng.Range("A3").End(xlDown)).Resize(, 9)
  76.                 'Sort :¸ê®Æ±Æ§Ç
  77.                 Rng.Sort Key1:=Rng.Range("B2"), Order1:=xlDescending, Header:=xlYes ', _
  78.                 OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, SortMethod _
  79.                 :=xlStroke, DataOption1:=xlSortNorma
  80.                 If .Row = 1 Then
  81.                     .Range("A2").EntireRow.Delete
  82.                 Else
  83.                     .Range("A2:A4").EntireRow.Delete
  84.                 End If
  85.             End With
  86.         End With
  87.     End With
  88.     Exit Sub
  89. ER:
  90.     ThisWorkbook.VBProject.References.AddFromFile "C:\windows\system32\FM20.DLL"
  91.     Resume
  92. End Sub
  93. Sub Maketxt(xF As String, Q As Range, Code As String)     '±N¶×¤J¸ê®Æ¦s¤J«ü©wªºtxt
  94.     Dim fs As Object, E As Range, C As Variant
  95.     Set fs = CreateObject("Scripting.FileSystemObject")
  96.     Set fs = fs.CreateTextFile(xF, True)  '³Ð¨£¤@­ÓÀÉ®×,¦pÀɮצs¦b¥iÂл\±¼
  97.     For Each E In Q.Rows
  98.         C = Application.Transpose(Application.Transpose(E.Value))
  99.         C = Join(C, vbTab)
  100.         fs.WriteLine C
  101.     Next
  102.     fs.Close
  103. End Sub
  104. Sub MkDir_Sub(S As String)
  105.     Dim ar, i As Integer, xPath As String
  106.     If Dir(S) = "" Then
  107.         ar = Split(S, "\")
  108.         xPath = ar(0)
  109.         For i = 1 To UBound(ar) - 1
  110.             xPath = xPath & "\" & ar(i)
  111.             If Dir(xPath, vbDirectory) = "" Then MkDir xPath
  112.         Next
  113.     End If
  114. End Sub
½Æ»s¥N½X
¶°«O¤á+¤å¦rÀÉ.zip (24.3 KB)

TOP

¥»©«³Ì«á¥Ñ GBKEE ©ó 2014-5-20 16:04 ½s¿è

¦^´_ 59# smart3135
  1. Option Explicit
  2. Dim IE As Object, A As Integer
  3. Sub IE_Application()
  4.     Dim i As Integer
  5.     Set IE = CreateObject("InternetExplorer.Application")
  6.     With IE
  7.         .Navigate "http://www.tdcc.com.tw/smWeb/QryStock.jsp"
  8.         .Visible = True   '¤£Åã¥Üie
  9.         Do While .Busy Or .readyState <> 4: DoEvents: Loop
  10.         'Ū¨ú¶°«O¤áªÑÅv¤À´²ªí¬d¸ßªº¸ê®Æ¤é´ÁÁ`­Ó¼Æ
  11.         A = .document.getelementsByTagName("select")("SCA_DATE").Length - 1
  12.   End With
  13. End Sub
  14. Sub ¶°«O()
  15.     Dim Rng As Range, E As Range, x As Variant, T As Date, xPath As String, xFile As String
  16.     Dim Ea As Variant, ii As Integer
  17.     T = Time
  18.     Application.DisplayStatusBar = True
  19.     '½Ð±N¤WÂdªºªÑ²¼¥N¸¹,¦b Sheets(3).Range("A1")©¹¤UKey¤W,°j°é¨Ì³o¸ÌªºªÑ²¼¥N¸¹¶×¤J
  20.     Set Rng = ThisWorkbook.Sheets(3).Range("A:A")
  21.     If Application.Count(Rng) = 0 Then MsgBox "¨S¦³ªÑ²¼¥N¸¹": Exit Sub
  22.     Set Rng = Rng.SpecialCells(xlCellTypeConstants)
  23.     xPath = "D:\°]³ø¸ê®Æ"
  24.     IE_Application    '
  25.     Application.StatusBar = " "
  26.     For Each E In Rng
  27.         With Sheets(1)
  28.             .Activate
  29.             .Cells.Clear  '¤U¸ü¸ê®Æ¸m©ó¦¹¤u§@ªí,ÅÜ´«ªÑ²¼®É:²MªÅ
  30.         End With
  31.         For x = 0 To A
  32.             With IE
  33.                 .document.getelementsByTagName("select")("SCA_DATE")(x).Selected = True
  34.                                             '³o¸Ìªº¸ê®Æ¤é´Á »Ý¥Î Select ¥¦¬O¦³[¦~«×¤ë¥÷¤é´Á]ªº
  35.                  .document.getElementById("StockNo").Value = E
  36.                     .document.getelementsByTagName("INPUT")("sub").Click  '«ö¤U¬d¸ß
  37.                        '³o¸Ìªº¬d¸ß¬O<INPUT TYPE="submit" VALUE="¬d¸ß" name="sub">
  38.                 'End With
  39.                 Do While .Busy Or .readyState <> 4:    Loop
  40.                 Ep .document.getelementsByTagName("TABLE")(7).outerHTML
  41.             End With
  42.         Next x
  43.         xFile = xPath & "\" & E & "\SHD.txt"
  44.         MkDir_Sub xFile
  45.         
  46.         Maketxt xFile, Sheets(1).Range("A1").CurrentRegion, E.Value
  47.         '***·Q½Ð°Ý±zCode As StringªºCode¬O«ç»ò±a¥X­ÓªÑ½s¸¹ªº ****
  48.         'xFile(²Ä¤@­Ó¤Þ¼Æ), Sheets(1).Range("A1").CurrentRegion(²Ä¤G­Ó¤Þ¼Æ),E.Value(²Ä¤T­Ó¤Þ¼Æ)
  49.         
  50.         ii = ii + 1
  51.         Application.StatusBar = Application.Text(Time - T, ["MM¤ÀSS¬í"]) & " ¦@¶×¤J¤W¥«¤ë¦¨¥æ " & ii & " ¤å¦rÀÉ"
  52.     Next E
  53.     IE.Quit
  54.     Application.StatusBar = Application.Text(Time - T, ["MM¤ÀSS¬í"]) & " ¦@¶×¤J¤W¥«¤ë¦¨¥æ " & ii & " ¤å¦rÀÉ,  Åª¨ú§¹²¦ !! "
  55.     MsgBox "¶×¤J ¤å¦rÀÉ" & ii & " ¶O®É " & Application.Text(Time - T, ["MM¤ÀSS¬í"])
  56. '    ThisWorkbook.Save
  57. End Sub
  58. Sub Maketxt(xF As String, Q As Range, Code As String)     '±N¶×¤J¸ê®Æ¦s¤J«ü©wªºtxt
  59.           '***·Q½Ð°Ý±zCode As StringªºCode¬O«ç»ò±a¥X­ÓªÑ½s¸¹ªº ****
  60.           ' xF(±µ¦¬ªº¤Þ¼Æ¦WºÙ) As String(¦r¦ê«¬ºA), Q As Range(Rangeª«¥ó«¬ºA), Code As String(¦r¦ê«¬ºA)
  61.     Dim fs As Object, E As Range, C As Variant
  62.     Set fs = CreateObject("Scripting.FileSystemObject")
  63.     Set fs = fs.CreateTextFile(xF, True)  '³Ð¨£¤@­ÓÀÉ®×,¦pÀɮצs¦b¥iÂл\±¼
  64.     For Each E In Q.Rows
  65.         C = Application.Transpose(Application.Transpose(E.Value))
  66.         C = Join(C, vbTab)
  67.         fs.WriteLine C
  68.     Next
  69.     fs.Close
  70. End Sub
½Æ»s¥N½X
·P®¦ªº¤ß......(¦b³Â»¶®a±Ú°Q½×°Ï.¥Î¤ß¾Ç²ß·|¦³¶i¨Bªº)
¦ý¸ê·½µL­­,«á´©¦³­­,  ¤@¤Ñ1¤¸ªºÃÙ§U,¤H¤H¦³¯à¤O.

TOP

        ÀR«ä¦Û¦b : ­×¦æ­nô½t­×¤ß¡AÂǨƽm¤ß¡AÀH³B¾i¤ß¡C
ªð¦^¦Cªí ¤W¤@¥DÃD