Sub Hi_stock() 'Dim date_1 As Date 'date_1 = Date 'year_now = Year(date_1) 'month_now = Month(date_1) 'day_now = Day(date_1) request_day = year_input_1 * 365 'start_year = year_now - year_input_1 'start_date_1 = start_year & "/" & month_now & "/" & day_now ' Perpetual Calendar Diplay 'start_date_2 = DateDiff("s", "1970-1-1 0:0:0", start_date_1) 'Unix 十 digit display 'start_date_2 = DateDiff("s", "1970-1-1 0:0:0", start_date_1) & "000" 'Unix + three digit display 'end_date_1 = year_now & "/" & month_now & "/" & day_now 'Perpetual Calendar Display 'end_date_2 = DateDiff("s", "1970-1-1 0:0:0", end_date_1) 'Unix 十digit display 'end_date_2 = DateDiff("s", "1970-1-1 0:0:0", end_date_1) & "000" 'Unix 十three digit display 'Hi investment historical stock price download 'url_1 = "https://histock.tw/stock/chip/chartdata.aspx?no=" & stock_no_1 & "&days=" & request_day & _ "&m=dailyk%2Cclose%2Cvolume%2Cmean5%2Cmean10%2Cmean20%2Cmean60%2Cmean120%2Cmean5volume%2Cmean20volume" & _ "%2Ck9%2Cd9%2Crsi6%2Crsi12%2Cdif%2Cmacd%2Cosc&fbclid=IwAR0w4tNJGIm8iSRsh7Zj_DBWESNSJ8DLJurdLZZR3--7vAkh5Xd7rPpT_bw" Dim myXML As Object Dim url_1 As String Dim response As String Dim json As Object Dim data As Object Dim ostream As Object Set myXML = CreateObject("MSXML2.XMLHTTP") url_1 = "https://histock.tw/stock/chip/chartdata.aspx?no=1101&days=5&m=dailyk" With myXML .Open "GET", url_1, False .setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 10.0; Win64; x64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/123.0.0.0 Safari/537.36" .send response = myXML.responseText 'Debug.Print response 'Set json = JsonConverter.ParseJson(response) 'Set data = json("DailyK") 'Debug.Print stock 'If Asc(year_input_1) > 50 Then 'Application.Wait Now + TimeValue("00:00:20") 'End If If myXML.Status = 200 Then Set ostream = CreateObject("ADODB.Stream") ostream.Open ostream.Type = 1 ostream.write myXML.responseBody ostream.savetofile "C:\stock\data\1101.csv", 2 ostream.Close Else 'nothing 'no_stock (work_book) End If End With 'Stock Price Data display Workbooks.Open Filename:="C:\stock\data\1101.csv" Windows("1101.csv").Activate a = 1 Do Until Cells(1, a) = "" a = a + 1 Loop 'Special Characters & non stock price data removal remove_list = "[]{}()""""" For a1 = 1 To a - 1 If a1 = 1 Then For i = 1 To Len(Cells(1, a1)) If Asc(Mid(Cells(1, a1), i, 1)) >= 48 And Asc(Mid(Cells(1, a1), i, 1)) <= 57 Then 'nothing On Error Resume Next Else If Asc(Mid(Cells(1, a1), i, 1)) = 46 Then 'nothing Else Cells(1, a1) = Replace$(Cells(1, a1), Mid$(Cells(1, a1), i, 1), "") i = 1 End If End If Next i Cells(1, 1) = Replace$(Cells(1, 1), Mid$(Cells(1, 1), 1, 1), "") Else For i = 1 To Len(remove_list) Cells(1, a1) = Replace$(Cells(1, a1), Mid$(remove_list, i, 1), "") Next If Asc(Mid(Cells(1, a1), 1, 1)) >= 48 And Asc(Mid(Cells(1, a1), 1, 1)) <= 57 Then 'nothing Else Range(Cells(1, a1), Cells(1, a - 1)).Clear Exit For End If End If Next a1 On Error GoTo error_stop Windows("1101.csv").Save a = 1 Do Until Cells(1, a) = "" a = a + 1 Loop If Len(Dir("C:\stock\analysis" & stock_no_1 & ".xlsx")) > 0 Then Kill "C:\stock\analysis" & stock_no_1 & ".xlsx" ''SetAttr "C:\stock\analysis\*.*", vbNormal ' Troubleshoot read only file issues Workbooks.Add Application.DisplayAlerts = False ActiveWorkbook.SaveAs Filename:="C:\stock\analysis\1101.xlsx" Application.DisplayAlerts = True Windows("1101.xlsx").Activate ActiveSheet.Name = "Price" Cells(1, 1) = "Date" Cells(1, 2) = "Open" Cells(1, 3) = "Highest" Cells(1, 4) = "Lowest" Cells(1, 5) = "Close" 'Pause four things that tend to slow down Excel 功能 Application.Calculation = xlCalculationManual Application.ScreenUpdating = False Application.DisplayStatusBar = False Application.EnableEvents = False b = 2 For a = 1 To a - 1 Step 5 Workbooks("1101.csv").Sheets("1101").Activate Range(Cells(1, a), Cells(1, a + 4)).Select Selection.Copy Workbooks("1101.xlsx").Sheets("Price").Activate Cells(b, 1).Select ActiveSheet.Paste b = b + 1 Next a Workbooks("1101.xlsx").Sheets("Price").Activate a = 1 Do Until Cells(a, 1) = "" a = a + 1 Loop For a = 2 To a - 1 Cells(a, 1) = (Cells(a, 1) / 1000 + 8 * 3600) / 86400 + 70 * 365 + 19 Cells(a, 1) = Format(Cells(a, 1), "yyyy-mm-dd") 'Pause four things that tend to slow down Excel function Application.Calculation = xlCalculationAutomatic Application.ScreenUpdating = True Application.DisplayStatusBar = True Application.EnableEvents = True Rows("1:1").Select ActiveWindow.FreezePanes = True Workbooks("1101.csv").Activate Application.DisplayAlerts = False Windows("1101.csv").Close (vb = Yes) Application.DisplayAlerts = True 'dividend_process work_book, data_type, year_input_1, stock_no_1, data_row Exit Sub error_stop: For file_check = 1 To Workbooks.Count If Workbooks(file_check).Name = "*.csv" Then Windows("*.csv").Activate Application.DisplayAlerts = False Windows("*.csv").Close (vb = no) Application.DisplayAlerts = True End If Next file_check 'For file_check = 1 To Workbooks.Count 'If Workbooks(file_check).Name = "1101.xlsx" Then 'Windows("1101.xlsx").Activate 'Application.DisplayAlerts = False 'Windows("1101.xlsx").Close (vb = no) 'Application.DisplayAlerts = True 'Exit For 'End If 'Next file_check Resume Next End Sub