GBKEE

¦^´_ 2# smart3135
¸Õ¸Õ¬Ý

1. Option Explicit
   
2. Sub §ì©u·l¯qªí¸ê®Æ()
   
3.     Dim Rng As Range, AR(), URL As String, E As Variant
   
4.     For E = Sheets.Count To 2 Step -1
   
5.         Sheets(E).Delete   '¤u§@ªí§R°£
   
6.     Next
   
7.     AR = Array(2303, 2485, 2030)
   
8.     Sheets(1).Range("A1:A3") = Application.WorksheetFunction.Transpose(AR)
   
9.     Set Rng = Sheets(1).Range("A1:A3")
   
10.     For Each E In Rng   '°j°é Àx¦s®æ
    
11.     ' For Each E In AR  '°j°é ¤]¥i¥H¥Î°}¦C
    
12.         With Sheets.Add(, Sheets(1))  '·s¼W¤u§@ªí
    
13.             .Name = E
    
14.             URL = "URL;https://djinfo.cathaysec.com.tw/Z/ZC/ZCQ/ZCQ.DJHTM?A=" & E
    
15.             With .QueryTables.Add(Connection:=URL, Destination:=.Range("$A$1"))
    
16.                 .Name = "ZCQ.DJHTM?A=" & E
    
17.                 .PreserveFormatting = True
    
18.                 .BackgroundQuery = True
    
19.                 .RefreshStyle = xlInsertDeleteCells
    
20.                 .SaveData = True
    
21.                 .AdjustColumnWidth = True
    
22.                 .RefreshPeriod = 0
    
23.                 .WebSelectionType = xlSpecifiedTables
    
24.                 .WebFormatting = xlWebFormattingNone
    
25.                 .WebTables = "3"
    
26.                 .WebPreFormattedTextToColumns = True
    
27.                 .WebConsecutiveDelimitersAsOne = True
    
28.                 .Refresh BackgroundQuery:=False
    
29.             End With
    
30.         End With
    
31.     Next
    
32. End Sub

½Æ»s¥N½X

GBKEE

¦^´_ 5# smart3135

1. Option Explicit
   
2. Sub §ì©u·l¯qªí¸ê®Æ()
   
3.     Dim E As Integer
   
4.     Application.DisplayAlerts = False  '°±¤î¨t²ÎªºÄµ§i´£¥Ü
   
5.     For E = 1101 To 2330
   
6.         With Sheets.Add(, Sheets(1))   '·s¼W¤u§@ªí
   
7.             .Name = E
   
8.             URL = "URL;https://djinfo.cathaysec.com.tw/Z/ZC/ZCQ/ZCQ.DJHTM?A=" & E
   
9.             With .QueryTables.Add(Connection:=URL, Destination:=.Range("$A$1"))
   
10.                 .Name = "ZCQ.DJHTM?A=" & E
    
11.                 .PreserveFormatting = True
    
12.                 .BackgroundQuery = True
    
13.                 .RefreshStyle = xlInsertDeleteCells
    
14.                 .SaveData = True
    
15.                 .AdjustColumnWidth = True
    
16.                 .RefreshPeriod = 0
    
17.                 .WebSelectionType = xlSpecifiedTables
    
18.                 .WebFormatting = xlWebFormattingNone
    
19.                 .WebTables = "3"
    
20.                 .WebPreFormattedTextToColumns = True
    
21.                 .WebConsecutiveDelimitersAsOne = True
    
22.                 .Refresh BackgroundQuery:=False
    
23.             End With
    
24.             
    
25.             If .[A1] = -E Then  '³oºô­¶¦pªÑ²¼¥N½X¿ù»~·|¶Ç¦^­t¸¹.
    
26.                 Stop            'STOP ¬Oµ¹§A¦^¨ì¤u§@ªíÅçÃÒ¥Î,¥i§R±¼³oµ{¦¡½X
    
27.                 ActiveSheet.Delete
    
28.             End If
    
29.         End With
    
30.     Next
    
31.     Application.DisplayAlerts = True   'µ{¦¡µ²³t:«ì´_¨t²ÎªºÄµ§i´£¥Ü
    
32. End Sub

½Æ»s¥N½X

GBKEE

¦^´_ 7# smart3135
¸Õ¸Õ¬Ý

1. Option Explicit
   
2. Sub §ì©u·l¯qªí¸ê®Æ()
   
3.     Dim E As Integer, URL As String, xPath As String
   
4.     URL = "URL;https://djinfo.cathaysec.com.tw/Z/ZC/ZCQ/ZCQ.DJHTM?A="
   
5.     xPath = "C:\©u·l¯qªí"
   
6.     '¦sÀɸô®|¬OC:\E\XYZ.TXT, «Øij§ï¬° C:\©u·l¯qªí\1101.txt
   
7.     With ThisWorkbook
   
8.        ' If .Sheets.Count = 1 Then .Sheets.Add  '°t¦XŪ¨útxtÀɨì¤u§@ªí®É¥²¶·¦³2±i¤u§@ªí
   
9.         With .Sheets(1)   '¬¡­¶Ã¯ªº²Ä 1 ±i¤u§@ªí
   
10.             If .QueryTables.Count = 0 Then
    
11.                 With .QueryTables.Add(Connection:=URL, Destination:=.Range("$A$1"))
    
12.                     .Refresh BackgroundQuery:=False
    
13.                 End With
    
14.             End If
    
15.             For E = 1101 To 2330
    
16.                 With .QueryTables(1)
    
17.                     .Connection = URL & E
    
18.                     .PreserveFormatting = True
    
19.                     .BackgroundQuery = True
    
20.                     .RefreshStyle = xlInsertDeleteCells
    
21.                     .SaveData = True
    
22.                     .AdjustColumnWidth = True
    
23.                     .RefreshPeriod = 0
    
24.                     .WebSelectionType = xlSpecifiedTables
    
25.                     .WebFormatting = xlWebFormattingNone
    
26.                     .WebTables = "3"
    
27.                     .WebPreFormattedTextToColumns = True
    
28.                     .WebConsecutiveDelimitersAsOne = True
    
29.                     .Refresh BackgroundQuery:=False
    
30.                 End With
    
31.                 If .[A1] <> -E Then  '³oºô­¶¦pªÑ²¼¥N½X¿ù»~·|¶Ç¦^­t¸¹.
    
32.                     If Dir(xPath, vbDirectory) = "" Then MkDir xPath '¥Ø¿ý¤£¦s¦b«h·s¼x¼W¦¹¥Ø¿ý
    
33.                     Maketxt xPath & "\" & E & ".TXT", .QueryTables(1)
    
34.                     'Redalltxt xPath & "\" & E & ".TXT"  'Ū¨útxtÀɨì¤u§@ªí
    
35.                 End If
    
36.             Next
    
37.         End With
    
38.     End With
    
39. End Sub
    
40. Sub Maketxt(xF As String, Q As QueryTable)   '±N¶×¤J¸ê®Æ¦s¤J«ü©wªºtxt
    
41.     Dim fs As Object, E As Range, C As Variant
    
42.     Set fs = CreateObject("Scripting.FileSystemObject")
    
43.     Set fs = fs.CreateTextFile(xF, True)  '³Ð¨£¤@­ÓÀÉ®×,¦pÀɮצs¦b¥iÂл\±¼
    
44.     For Each E In Q.ResultRange.Rows
    
45.         C = Application.Transpose(Application.Transpose(E.Value))
    
46.         C = Join(C, vbTab)
    
47.         fs.WriteLine C
    
48.     Next
    
49.     fs.Close
    
50. End Sub
    
51. Sub Redalltxt(xF As String)   '
    
52.     Dim fs As Object, E, D As New DataObject
    
53.     'DataObject ª«¥ó ¦b¶i¦æÂà´«°Ê§@®É¡A°µ¬°®æ¦¡¤Æ¤å¦r¸ê®Æªº¼È¦s°Ï°ì¡C¨ä¤]¥i¥H¼È¦s©MÀx¦s¦b DataObject ªº¤å¦r¤ù¬q¬ÛÃöªº®æ¦¡¡C
    
54.     '«Å§i Dim D As New DataObject '¶·¦b¤u¨ã-> ³]©w¤Þ¥Î¶µ¥Ø¥[¤J ·s¼W¤Þ¥Î Microsoft Forms 2.0 Object Library ,±M®× ¥[¤J¤@ªí³æ§Y¥i
    
55.     Set fs = CreateObject("Scripting.FileSystemObject")
    
56.     Set fs = fs.OpenTextFile(xF, 1)
    
57.      E = fs.readall
    
58.     fs.Close
    
59.     With D
    
60.         .SetText E
    
61.         .PutInClipboard
    
62.         With Sheets(2)
    
63.             .UsedRange.Clear
    
64.             .Activate
    
65.             .Range("A1").Select
    
66.             .PasteSpecial Format:="Unicode ¤å¦r"
    
67.             .Cells.Font.Size = 12
    
68.             .Cells.Font.Bold = False
    
69.             .Cells.EntireColumn.AutoFit
    
70.         End With
    
71.     End With
    
72. End Sub
    
73. Sub Set_FormDLL()   '·s¼W¤Þ¥Î Microsoft Forms 2.0 Object Library
    
74.     On Error Resume Next
    
75.     FormDLL = "FM20.DLL"
    
76.     ThisWorkbook.VBProject.References.AddFromFile "C:\windows\system32\" & FormDLL
    
77. '2003ª©ªº¥Ø¿ý¬° C:\windows\system32\ ,§A»Ý­×§ï¦¹¥Ø¿ý
    
78. End Sub

½Æ»s¥N½X

¤U¸ü (74.84 KB)

2014-4-24 09:11

GBKEE

¦^´_ 9# smart3135

1. Option Explicit
   
2. Sub Ex()
   
3.     MkDir_Sub "D:\Test\©u·l¯qªí\1103\ISQ.txt"
   
4. End Sub
   
5. Sub MkDir_Sub(S As String)
   
6.     Dim AR, i As Integer, xPath As String
   
7.     If Dir(S) = "" Then
   
8.         AR = Split(S, "\")
   
9.         '¦pS°Ñ¼Æ©Ò±µ¦¬¦r¦ê="D:\MYSUB\ABC\1101.TXT
   
10.         'Split¨ç¼Æ±NS¥H"\"¤À³Î¬°°}¦C
    
11.         'AR(0) = "D:"
    
12.         'AR(1) = "MYSUB"
    
13.         'AR(2) = "ABC"
    
14.         'AR(3) = "1101.TXT"
    
15.         'UBound(AR)¶Ç¦^AR°}¦Cªº¤W­­¤¸¯À¯Á¤Þ­È,3
    
16.         xPath = AR(0)
    
17.         For i = 1 To UBound(AR) - 1
    
18.             xPath = xPath & "\" & AR(i)
    
19.             If Dir(xPath, vbDirectory) = "" Then MkDir xPath
    
20.             'MkDir : ³Ð«Ø¥Ø¿ý
    
21.         Next
    
22.     End If
    
23. End Sub

½Æ»s¥N½X

GBKEE

¦^´_ 12# smart3135

1. Option Explicit
   
2. Sub §ì©u·l¯qªí¸ê®Æ()
   
3.     Dim E As Integer, URL As String, xPath As String, xFile As String
   
4.     Dim Msg As Boolean
   
5.     URL = "URL;https://djinfo.cathaysec.com.tw/Z/ZC/ZCQ/ZCQ.DJHTM?A="
   
6.     xPath = "C:\©u·l¯qªí"
   
7.     With ThisWorkbook
   
8.         With .Sheets(1)      '¬¡­¶Ã¯ªº²Ä 1 ±i¤u§@ªí
   
9.             If .QueryTables.Count = 0 Then
   
10.                 With .QueryTables.Add(Connection:=URL, Destination:=.Range("$A$1"))
    
11.                     .Refresh BackgroundQuery:=False
    
12.                 End With
    
13.             End If
    
14.             For E = 1339 To 2330
    
15. ER:
    
16.                 With .QueryTables(1)
    
17.                     If Msg = False Then
    
18.                       .Connection = URL & E
    
19.                     ElseIf Msg Then
    
20.                                   'https://djinfo.cathaysec.com.tw/z/zc/zcq/zcq0_1339_ACC.djhtm   ·l¯qªí(²Ö­p©uªí)
    
21.                        .Connection = "URL;https://djinfo.cathaysec.com.tw/z/zc/zcq/zcq0_" & E & "_ACC.djhtm"
    
22.                     End If
    
23.                     .PreserveFormatting = True
    
24.                     .BackgroundQuery = True
    
25.                     .RefreshStyle = xlInsertDeleteCells
    
26.                     .SaveData = True
    
27.                     .AdjustColumnWidth = True
    
28.                     .RefreshPeriod = 0
    
29.                     .WebSelectionType = xlSpecifiedTables
    
30.                     .WebFormatting = xlWebFormattingNone
    
31.                     .WebTables = "3"
    
32.                     .WebPreFormattedTextToColumns = True
    
33.                     .WebConsecutiveDelimitersAsOne = True
    
34.                     .Refresh BackgroundQuery:=False
    
35.                 End With
    
36.                 If InStr(.[A3], "¬dµL") Then Msg = True: GoTo ER
    
37.                 If InStr(.[A3], "­ÓªÑ¥N½X¿ù»~") = 0 Then '³oºô­¶¦pªÑ²¼¥N½X¿ù»~·|¶Ç¦^­t¸¹.
    
38.                      xFile = xPath & "\" & E & "\ISQ.txt"
    
39.                     MkDir_Sub xFile       '10#ªºµ{¦¡ 'C¼Ñ¤Uªº©u·l¯qªí¸ê®Æ§¨¤£»Ý¥ý«Ø¥ß
    
40.                     Maketxt xFile, .QueryTables(1)
    
41.                 End If
    
42.                 Msg = False
    
43.             Next
    
44.         End With
    
45.     End With
    
46. End Sub

½Æ»s¥N½X

GBKEE

¦^´_ 14# smart3135
µù¸Ñ¦³¦b¬Ý¶Ü? ­n½Æ»s²Ä10#ªº MkDir_Sub µ{¦¡¨ì¼Ò²Õ¤W.

GBKEE

¦^´_ 17# smart3135
10# ªºµ{¦¡½X¬Ý¤£À´,¤w¥[µù»¡©ú¤F.
·|¥X²{°O¾ÐÅ餣¨¬ªºµøµ¡,¦bXP,°O¾ÐÅé1GB,2003ª©,°õ¦æ5¤ÀÄÁ¤º¥i§¹¦¨,ÂX¥R§Aªº°O¾ÐÅé¸Õ¸Õ¬Ý
¥þ³¡ª½±µ¶K¨ìtxt¤¤¡A³o¼ËÀ³¸Ó´N¤£¥Î¨«°j°é,ºCºC¦A¬ã¨s.

GBKEE

¦^´_ 19# smart3135
§A¥Îªº¬O https://djinfo.cathaysec.com.tw/z/zc/zcq/zcqa/zcqa.djhtm
¥i­×§ï¦p¤U

1. End With
   
2.                
   
3.                 If InStr(.[A3], "¬dµL") And Msg = True Then GoTo xlNext
   
4.                 If InStr(.[A3], "¬dµL") Then Msg = True: GoTo ER
   
5.                 If InStr(.[A3], "­ÓªÑ¥N½X¿ù»~") = False Then '³oºô­¶¦pªÑ²¼¥N½X¿ù»~·|¶Ç¦^­t¸¹.
   
6.                     xFile = xPath & "\" & E & "\IS.txt"
   
7.                     MkDir_Sub xFile       '10#ªºµ{¦¡ 'C¼Ñ¤Uªº©u·l¯qªí¸ê®Æ§¨¤£»Ý¥ý«Ø¥ß
   
8.                     Maketxt xFile, .QueryTables(1)
   
9.                 End If
   
10. xlNext:
    
11.                 Msg = False
    
12.             Next

½Æ»s¥N½X

GBKEE

¦^´_ 22# smart3135

1. End With               
   
2.                 If E = 1420 Then GoTo xlNext   '¥[¤W¸Õ¸Õ¬Ý
   
3.             'If InStr(.[A3], "¬dµL") And Msg = True Or E = 1420 Then GoTo xlNext  '©ÎªÌ¥i³o¼Ë¼g
   
4.             If InStr(.[A3], "¬dµL") Then Msg = True: GoTo ER
   
5.                 If InStr(.[A3], "­ÓªÑ¥N½X¿ù»~") = False Then '³oºô­¶¦pªÑ²¼¥N½X¿ù»~·|¶Ç¦^­t¸¹.
   
6.                     xFile = XPath & "\" & E & "\IS.txt"
   
7.                     MkDir_Sub xFile       '10#ªºµ{¦¡ 'C¼Ñ¤Uªº©u·l¯qªí¸ê®Æ§¨¤£»Ý¥ý«Ø¥ß
   
8.                     Maketxt xFile, .QueryTables(1)
   
9.                 End If
   
10. xlNext:
    
11.                 Msg = False
    
12.             Next

½Æ»s¥N½X

GBKEE

¦^´_ 24# smart3135
1420 key¿ù¦¨ 2149 ¥i²¤Æ¤£»Ý If E = 1420 Then GoTo xlNext

1. Rows(1).Delete
   
2.                 Columns(1).Delete
   
3.             AR = Array(1420, 1580, 2000)  '§A¬O­n¤@­Ó¤@­Ó§ä¥Xªº
   
4.             For E = 1101 To 3000
   
5.                 X = Application.Match(E, AR, 0)
   
6.                 If IsNumeric(X) Then GoTo xlNext  'ª½±µ¨ì xlNext¦æ
   
7.                                                  ' 'If E = 1420 Then GoTo xlNext   '¤£»Ý­n
   
8. ER:
   
9.                 With .QueryTables(1)
   
10.                

½Æ»s¥N½X