- ©«¤l
- 96
- ¥DÃD
- 18
- ºëµØ
- 0
- ¿n¤À
- 125
- ÂI¦W
- 0
- §@·~¨t²Î
- Windows 7
- ³nÅ骩¥»
- Office 2007
- ¾\ŪÅv
- 20
- ©Ê§O
- ¨k
- µù¥U®É¶¡
- 2014-3-23
- ³Ì«áµn¿ý
- 2022-8-2
|
¥»©«³Ì«á¥Ñ smart3135 ©ó 2014-4-24 13:43 ½s¿è
¦^´_ smart3135
¸Õ¸Õ¬Ý
GBKEE µoªí©ó 2014-4-24 09:07
©I¡Iªá¤FÂI®É¶¡ºCºC¬ã¨s¤@ÓÓµ{¦¡½Xªº·N«ä¤Î»yªk¡A¦A±NGBKEEª©¤j´£¨Ñªºµ{¦¡½Xµy°µ×§ï¡A²×©ó§¹¦¨¤F¡I²{¦b¥un°õ¦æVBA´N¯à±N§ÚnªºISQ.TXTÀÉ©ñ¦b
°j°éÅܼÆE©Ò²£¥Íªº¸ê®Æ§¨¤U¡A¤]´N¬OC:\©u·l¯qªí\1101\¡BC:\©u·l¯qªí\1102\¡A°ß¤@nª`·Nªº¬OC¼Ñ¤Uªº©u·l¯qªí¸ê®Æ§¨¤@©wn¦Û¤v¥ý«Ø¥ß¡A§_«h°õ¦æµ{¦¡®É·|¥X¿ù
²{¦b´N¥u³Ñ¤U¤W¤@½g´£¥Xªº°ÝÃD¡G·í§ì¨úºô¶¸ê®Æ®ÉYµL¸ê®Æn¦p¦ó¸õ¹L©Î¥h§ì¨ú¦³¸ê®Æªººô¶¥HÁקK¥X¿ù¡A¦A½ÐGBKEE¤j¤j«üÂIÅo¡I·P®¦¡I- Option Explicit
- Sub §ì©u·l¯qªí¸ê®Æ()
- Dim E As Integer, URL As String, xPath As String, ISQ As String
- URL = "URL;https://djinfo.cathaysec.com.tw/Z/ZC/ZCQ/ZCQ.DJHTM?A="
- For E = 1101 To 2330
- xPath = "C:\" & "©u·l¯qªí" & "\" & E & "\"
- '¦sÀɸô®|¬OC:\E\XYZ.TXT, «Øij§ï¬° C:\©u·l¯qªí\1101.txt
- With ThisWorkbook
- ' If .Sheets.Count = 1 Then .Sheets.Add '°t¦XŪ¨útxtÀɨì¤u§@ªí®É¥²¶·¦³2±i¤u§@ªí
- With .Sheets(1) '¬¡¶Ã¯ªº²Ä 1 ±i¤u§@ªí
- If .QueryTables.Count = 0 Then
- With .QueryTables.Add(Connection:=URL, Destination:=.Range("$A$1"))
- .Refresh BackgroundQuery:=False
- End With
- End If
- With .QueryTables(1)
- .Connection = URL & E
- .PreserveFormatting = True
- .BackgroundQuery = True
- .RefreshStyle = xlInsertDeleteCells
- .SaveData = True
- .AdjustColumnWidth = True
- .RefreshPeriod = 0
- .WebSelectionType = xlSpecifiedTables
- .WebFormatting = xlWebFormattingNone
- .WebTables = "3"
- .WebPreFormattedTextToColumns = True
- .WebConsecutiveDelimitersAsOne = True
- .Refresh BackgroundQuery:=False
- End With
- If .[A1] <> -E Then '³oºô¶¦pªÑ²¼¥N½X¿ù»~·|¶Ç¦^t¸¹.
- If Dir(xPath, vbDirectory) = "" Then MkDir xPath '¥Ø¿ý¤£¦s¦b«h·s¼x¼W¦¹¥Ø¿ý
- Maketxt xPath & "ISQ.TXT", .QueryTables(1)
- 'Redalltxt xPath & "\" & E & ".TXT" 'Ū¨útxtÀɨì¤u§@ªí
- End If
-
- End With
- End With
- Next
- End Sub
- Sub Maketxt(xF As String, Q As QueryTable) '±N¶×¤J¸ê®Æ¦s¤J«ü©wªºtxt
- Dim fs As Object, E As Range, C As Variant
- Set fs = CreateObject("Scripting.FileSystemObject")
- Set fs = fs.CreateTextFile(xF, True) '³Ð¨£¤@ÓÀÉ®×,¦pÀɮצs¦b¥iÂл\±¼
- For Each E In Q.ResultRange.Rows
- C = Application.Transpose(Application.Transpose(E.Value))
- C = Join(C, vbTab)
- fs.WriteLine C
- Next
- fs.Close
- End Sub
- Sub Redalltxt(xF As String) '
- Dim fs As Object, E, D As New DataObject
- 'DataObject ª«¥ó ¦b¶i¦æÂà´«°Ê§@®É¡A°µ¬°®æ¦¡¤Æ¤å¦r¸ê®Æªº¼È¦s°Ï°ì¡C¨ä¤]¥i¥H¼È¦s©MÀx¦s¦b DataObject ªº¤å¦r¤ù¬q¬ÛÃöªº®æ¦¡¡C
- '«Å§i Dim D As New DataObject '¶·¦b¤u¨ã-> ³]©w¤Þ¥Î¶µ¥Ø¥[¤J ·s¼W¤Þ¥Î Microsoft Forms 2.0 Object Library ,±M®× ¥[¤J¤@ªí³æ§Y¥i
- Set fs = CreateObject("Scripting.FileSystemObject")
- Set fs = fs.OpenTextFile(xF, 1)
- E = fs.readall
- fs.Close
- With D
- .SetText E
- .PutInClipboard
- With Sheets(2)
- .UsedRange.Clear
- .Activate
- .Range("A1").Select
- .PasteSpecial Format:="Unicode ¤å¦r"
- .Cells.Font.Size = 12
- .Cells.Font.Bold = False
- .Cells.EntireColumn.AutoFit
- End With
- End With
- End Sub
- Sub Set_FormDLL() '·s¼W¤Þ¥Î Microsoft Forms 2.0 Object Library
- On Error Resume Next
- FormDLL = "FM20.DLL"
- ThisWorkbook.VBProject.References.AddFromFile "C:\windows\system32\" & FormDLL
- '2003ª©ªº¥Ø¿ý¬° C:\windows\system32\ ,§A»Ýק惡¥Ø¿ý
- End Sub
½Æ»s¥N½X |
|