返回列表 上一主題 發帖

[發問] ACCESS網頁上抓取資料

[發問] ACCESS網頁上抓取資料

以下的程式碼是在版上看到的
請問各位大大有可能直接把資料存入ACCESS嗎
感謝

Sub 簡易明細下載()
    Dim 股票代號 As String, 日期 As Variant, N, i As Integer, A, T As Date
    Do While Not IsDate(日期)
        日期 = InputBox("輸入查詢日期", "日期", Date)
        If 日期 = "" Then End
    Loop
    Do While 股票代號 = ""
        股票代號 = InputBox("股票代號", "輸入查詢之股票代號", "1101")
        If 日期 = "" Then End
    Loop
    日期 = Format(日期, "yyyymmdd")
    T = Time
    With ActiveSheet
        For Each N In .Names
            N.Delete
        Next
        .Cells.Clear
        Application.StatusBar = False
        On Error GoTo A_Wait
        i = 1
        Do
            .Cells(Rows.Count, 1).End(xlUp).Offset(1).Select
            With .QueryTables.Add(Connection:="URL;http://bsr.twse.com.tw/bshtm/bshtm_report_Messages.aspx?strDate=" & 日期 & "&StartNumber=" & 股票代號 & "&FocusIndex=" & i, Destination:=Selection)
                .Name = 日期 & "_" & 股票代號 & "_" & i
                .WebSelectionType = xlSpecifiedTables
                .WebFormatting = xlWebFormattingNone
                .WebTables = "6"
                .WebPreFormattedTextToColumns = True
                .WebConsecutiveDelimitersAsOne = True
                .WebSingleBlockTextImport = False
                .WebDisableDateRecognition = False
                .WebDisableRedirections = False
              ''''''無法查詢時稍待  到  A_Wait: '''''
                .Refresh BackgroundQuery:=False
                If Application.CountA(.ResultRange) = 0 Then GoTo Out
                i = i + 1
            End With
            A = CreateObject("WScript.Shell").popup("請等後下載..." & Chr(10) & Chr(10) & "** 請勿按下  [確定] **", 4, 日期 & "_" & 股票代號 & "  第" & i & "頁", 16 * 3 + 0)
            Application.ScreenUpdating = True
        Loop
Out:
        .UsedRange.Columns.AutoFit
        .[A1].Select
        A = CreateObject("WScript.Shell").popup("共下載" & i & "頁", 5, 日期 & "_" & 股票代號, 48 + 0)
        Application.StatusBar = 股票代號 & " 共下載 " & i & "頁 費時 " & Format(Time - T, "HH:MM:SS")
    End With
    End
A_Wait:
    Application.StatusBar = "無法查詢等候5秒鐘"
    Application.Wait Now + TimeValue("00:00:05")
    Err.Clear
    Application.StatusBar = False
    Resume    '重返查詢
End Sub
jayer

回復 1# jayer
不好意思!想請問
統計券商個股進出量,可以做甚麼樣的分析!

TOP

本帖最後由 HSIEN6001 於 2012-4-19 23:47 編輯

回復 1# jayer


    剛剛下載看一下格式,應該沒問題
但我不會語法,只會用Access提供的巨集簡單操作

笨方法:先匯入成為新資料表,用查詢分成兩個區塊匯出

再同時匯入指定資料表格內

現在很晚了!
若你不介意我用笨方法,明天幫你放上來

TOP

忘了附上圖片
如下:
分區.png
2012-4-19 23:46

TOP

回復 1# jayer

我肯定是瘋了!居然會睡不著
乾脆弄好給你

直接開Access
按下已經設定的巨集就完成了

券商統計.rar (82.67 KB)

TOP

感謝HSIEN6001
不好意思,我只想知道個股他在某一段時間內在個券商的進出狀況
目前也不知道有沒有用
不過相信如果會分析應該用有點用吧
可以麻煩您寄給我嗎
我不能下載
感謝
mail:jayer.ms@msa.hinet.net
jayer

TOP

回復 6# jayer

券商個股進出資料匯入Access範例
    已經幫你mail 囉!

算是個簡單的笨方法,參考!
請依自己的需求再改過

TOP

回復 6# jayer

資質駑鈍,看不出統計之後;對交易分析有何幫助!
若有先進可提供分享
不勝感激!
:loveliness:

TOP

目前看書找到一個程序
程式碼如下是可以慢慢的將資入轉進資料庫裡喔
請問有大大有更好的方法嗎


Public Sub 執行SQL敘述()

    Dim cnnDB As New ADODB.Connection '建立資料庫連結物件
   
    Set cnnDB = CurrentProject.Connection '取得資料庫連結
   
    cnnDB.Execute " INSERT INTO 矽統的複本 " _
        & "SELECT * " _
        & "FROM [sheet2];"
           
    '執行SQL敘述
   
    cnnDB.Close '關閉資料庫連結
   
    Set cnnDB = Nothing '重設資料庫連結
   
End Sub
jayer

TOP

請問HSIEN6001

能否也寄一份 券商統計.rar 給我
我的 mail : white_5168@hotmail.com
Thanks.

TOP

        靜思自在 : 人的心地是一畦田,土地沒有播下好種子,也長不出好的果實。 -
返回列表 上一主題