[發問] 檔案下載問題

spermbank

各位大大好:
基本面資料夾中有12個檔案，可是每個檔案第1個sheet1有個按鈕"輸入個股"未開放巨集程式碼，且按下按鈕後會請求"請輸入個股代號"，我想從我自己設計的"個股基本面分析.xls"中的工作列-首頁1..
新增
    1、按下"下載所有股票基本面資料"會將首頁1的所有代號中的資料，依序存入檔案路徑中D:\data\(檔名為代號)
          (其中，所有代號中的資料內容包含:風險評估.xls把更新過後的工作列-IS、ISQ、BS、BSQ、BASIC、YrPrice、FR、CFS、ISQT及獲利指標.xls把更新過後的工作列-Revenue)
    因為基本面資料夾中有12個檔案未開放巨集程式碼，所以想請問大家及G大這要怎麼寫。

    2、按下"匯入個股資料"會跳出視窗顯示"請輸入個股代號"並且直接更新基本面資料夾中12個檔案，再把資料夾匯入我自己的"個股基本分析.xls"中的各工作列表.
         (舉例:從風險評估.xls把更新過後的工作列-IS、ISQ、BS、BSQ、BASIC、YrPrice、FR、CFS、ISQT匯入對應的工作列表中...)
PS:test.rar中基本面資料夾為網路搜尋，個股基本分析，分享給有研究股票的論壇朋友。

spermbank

回復 14# sp218882


    嗯嗯，謝謝你^^

sp218882

請問
本案與  http://forum.twbts.com/thread-4906-1-1.html  是否
有相同內容，或許可供參考

sp218882

以市場上office相容軟體（Open Office＿Calc ）打開檔案後，即可看到程式碼
也就是MS Office Excel 密碼功能對相容軟體（Open Office）是沒有用的
我嘗試打開   獲利指標.xls 看到巨集指令如下
Rem Attribute VBA_ModuleType=VBAModule
Sub Module1
Rem Sub 更新個股資料()
Rem     On Error Resume Next
Rem     Dim StockNum As String
Rem 0
Rem     StockNum = Application.InputBox("請輸入個股代號")
Rem     If StockNum <> "" Then
Rem     If Asc(StockNum) >= 48 And Asc(StockNum) <= 57 Then GoTo 1 '判定為數字就進行
Rem     End If
Rem     If StockNum = "False" Then GoTo 2   '若取消則退出
Rem     MsgBox ("請輸入個股代號")
Rem     GoTo 0
Rem 1
Rem     Sheets("IS").Select
Rem     With Selection.QueryTable
Rem         .Connection = "URL;http://dj.mybank.com.tw/z/zc/zcq/zcqa/zcqa_" & StockNum & ".asp.htm"
Rem         .WebSelectionType = xlSpecifiedTables
Rem         .WebFormatting = xlWebFormattingNone
Rem         .WebTables = "3"
Rem         .WebPreFormattedTextToColumns = True
Rem         .WebConsecutiveDelimitersAsOne = True
Rem         .WebSingleBlockTextImport = False
Rem         .WebDisableDateRecognition = False
Rem         .WebDisableRedirections = False
Rem         .Refresh BackgroundQuery:=False
Rem     End With
Rem     Selection.QueryTable.Refresh BackgroundQuery:=False
Rem
Rem     Sheets("ISQ").Select
Rem     With Selection.QueryTable
Rem         .Connection = "URL;http://dj.mybank.com.tw/z/zc/zcq/zcq_" & StockNum & ".asp.htm"
Rem         .WebSelectionType = xlSpecifiedTables
Rem         .WebFormatting = xlWebFormattingNone
Rem         .WebTables = "3"
Rem         .WebPreFormattedTextToColumns = True
Rem         .WebConsecutiveDelimitersAsOne = True
Rem         .WebSingleBlockTextImport = False
Rem         .WebDisableDateRecognition = False
Rem         .WebDisableRedirections = False
Rem         .Refresh BackgroundQuery:=False
Rem     End With
Rem     Selection.QueryTable.Refresh BackgroundQuery:=False
Rem     
Rem     Sheets("指標圖表").Select
Rem 2
Rem End Sub
Rem
Rem
End Sub

spermbank

回復 11# Hsieh


    謝謝大大，我再想想，確實有這工作簿，副檔名我也沒弄錯。
    感謝大大指教^^

Hsieh

回復 10# spermbank

關於程式碼出錯
請檢查Workbooks("營業收入變動.xls").Sheets("Revenue")    此工作表是否存在?(注意工作簿副檔名是否正確)

spermbank

回復 9# Hsieh
H大你好:
我將程式碼改成
    With ThisWorkbook
    For Each a In .Sheets(1).[A2:A1341] '每個代號循環
      Application.ScreenUpdating = False       '停止螢幕更新
      更新資料 a '執行12檔案更新
      Workbooks("風險評估.xls").Sheets(Array("IS", "ISQ", "BS", "BSQ", "BASIC", "YrPrice", "FR", "CFS", "ISQT")).Copy '複製工作表
      ActiveWorkbook.SaveAs ThisWorkbook.Path & "\" & CStr(a) & ".xlsx" '另存新檔
      Workbooks("營業收入變動.xls").Sheets("Revenue").Copy Before:=Workbooks(CStr(a) & ".xlsx").Sheets(1) '複製工作表
      關檔
    Next
    Application.ScreenUpdating = False       '停止螢幕更新
    End With
    仍然出現下列錯誤
    執行階段錯誤 ‘1004’ :
    Class Worksheet的Copy方法失敗
另外:
    H大說:原作者以按鈕驅動模組內程序，可利用複製工作表，就能看到工作表模組內程式碼，我不知道如何看到，不了解大大意思。
    想請教大大是不是可以看到部分的程式碼中看到下載更新的網址及相關程式碼、可以貼給我，或許我可以用G大教我的下載、速度問題相關程式，如法炮製的寫寫看。
    若不行再請大大協助。

Hsieh

回復 8# spermbank
要另存成xlsx檔案，前面的存檔就要一起改成xlsx
之前提到的不是每個檔案都有該程序，是因為我測試時沒有開放巨集導致誤解
原作者以按鈕驅動模組內程序，可利用複製工作表，就能看到工作表模組內程式碼
但是若要看到全部程式碼就必須破解，況且每個檔案程式碼是以InputBox輸入代碼
所以，要每個檔案修改程式碼不如重新撰寫

spermbank

回復 7# Hsieh


              Workbooks("營業收入變動.xlsm").Sheets("Revenue").Copy Before:=Workbooks(CStr(a) & ".xlsx").Sheets(1) '複製工作表
在執行程式時這上述兩行程式時，出現"ClassWorksheet的Copy方法失敗"
不知道如何解決，請大大指點。
另:
      大大回復的問題中
     但不是12檔案中都有"輸入個股資料"的程式碼
     是不是要用2003版本開就可以看到呢?
     還是只有破解一途呢?

Hsieh

回復 5# spermbank

我不善於破解
但依你敘述或許可試試在個股基本面分析.xls一般模組
執行更新主程序試試

1. Sub 更新主程序()
   
2. With ThisWorkbook
   
3. For Each a In .Sheets(1).[A2:A1341] '每個代號循環
   
4.   更新資料 a '執行12檔案更新
   
5.   Workbooks("風險評估.xls").Sheets(Array("IS", "ISQ", "BS", "BSQ", "BASIC", "YrPrice", "FR", "CFS", "ISQT")).Copy '複製工作表
   
6.   ActiveWorkbook.SaveAs ThisWorkbook.Path & "\" & CStr(a) & ".xls" '另存新檔
   
7.   Workbooks("營業收入變動.xls").Sheets("Revenue").Copy Before:=Workbooks(CStr(a) & ".xls").Sheets(1) '複製工作表
   
8.   關檔
   
9. Next
   
10. End With
    
11. End Sub
    
12. Sub 更新資料(a)
    
13. Dim Sh As Worksheet, MyURL$, MyQy As QueryTable
    
14. With ThisWorkbook
    
15. fd = .Path & "\基本面\"
    
16. fs = Dir(fd & "*.xls")
    
17. Do Until fs = ""
    
18. With Workbooks.Open(fd & fs)
    
19.    For Each Sh In .Sheets
    
20.       With Sh
    
21.       If .QueryTables.Count > 0 Then
    
22.          Set MyQy = .QueryTables(1)
    
23.          With .QueryTables(1)
    
24.          MyURL = .Connection
    
25.          If InStr(MyURL, "StockID") > 0 Then
    
26.             k = Val(Split(MyURL, "=")(UBound(Split(MyURL, "="))))
    
27.             Else
    
28.             k = Val(Split(MyURL, "_")(1))
    
29.          End If
    
30.          MyURL = Replace(MyURL, k, a)
    
31.          .Connection = MyURL '更改查詢
    
32.          .BackgroundQuery = False '幕前更新
    
33.          .Refresh '更新
    
34.          End With
    
35.       End If
    
36.       End With
    
37.    Next
    
38. End With
    
39. fs = Dir()
    
40. Loop
    
41. End With
    
42. End Sub
    
43. Sub 關檔()
    
44. For Each w In Windows
    
45. If w.Caption <> ThisWorkbook.Name Then w.Close 1
    
46. Next
    
47. End Sub

複製代碼