|
Excel - Как в ячейку получить курс евро из интернета
#36635784
Ссылка:
Ссылка на сообщение:
Ссылка с названием темы:
|
|
|
|
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
51.
52.
53.
54.
55.
56.
57.
58.
59.
60.
61.
62.
63.
64.
65.
66.
67.
68.
69.
70.
71.
72.
73.
74.
75.
76.
77.
78.
79.
80.
FUNCTION GetCursesFromWeb
PRIVATE i, poExcel, poActiveSheet, pcUrl, pdCusrDate, pdCurs, ta
ta = CREATEOBJECT("TabloAnl")
ta.first_date = DATE()
ta.last_date = DATE() + 1
ta.kod_sch = sprval.ITEM
IF !my_edit("CursDate", .F., .T.) THEN
RETURN .F.
ENDIF
poExcel = CREATEOBJECT("Excel.Application")
poExcel.WorkBooks.ADD()
*!* poExcel.ScreenUpdating= .T.
*!* poExcel.Visible= .T.
poActiveSheet = poExcel.ActiveSheet
*http://mirror.cbr.ru/currency_base/dynamics.asp?VAL_NM_RQ=R01035&r1= 0 &date_req1= 01 %2F09%2F2004&date_req2= 02 %2F09%2F2005&C_month= 09 &C_year= 2005 &rt= 0 &mode= 1 &val_name=%C0%ED%E3%EB%E8%E9%F1%EA%E8%E9+%F4%F3%ED%F2+%F1%F2%E5%F0%EB%E8%ED%E3&x= 42 &y= 6
************* Запрос к серверу cbr.ru
pcUrl = "URL;http://mirror.cbr.ru/currency_base/dynamics.asp?VAL_NM_RQ=R0"
pcUrl = pcUrl + Get_Name("sprval", "item", "cod_cbr", ta.kod_sch)
pcUrl = pcUrl + "&date_req1="
pcUrl = pcUrl + PADL(DAY(ta.first_date), 2 , "0") + "%2F"
pcUrl = pcUrl + PADL(MONTH(ta.first_date), 2 , "0") + "%2F"
pcUrl = pcUrl + PADL(YEAR(ta.first_date), 4 , "0")
pcUrl = pcUrl + "&r1=1&date_req2="
pcUrl = pcUrl + PADL(DAY(ta.last_date), 2 , "0") + "%2F"
pcUrl = pcUrl + PADL(MONTH(ta.last_date), 2 , "0") + "%2F"
pcUrl = pcUrl + PADL(YEAR(ta.last_date), 4 , "0")
pcUrl = pcUrl + "&C_month=" + PADL(MONTH(ta.first_date), 2 , "0")
pcUrl = pcUrl + "&C_year=" + PADL(YEAR(ta.first_date), 4 , "0")
pcUrl = pcUrl + "&rt=0&mode=1&val_name=%C4%EE%EB%EB%E0%F0+%D1%D8%C0&x=51&y=4"
WITH poActiveSheet.QueryTables.ADD(pcUrl, poActiveSheet.RANGE("A1"))
.WebTables = "38"
.REFRESH
ENDWITH
nStart = SECONDS()
Wait_msg("Идет чтение курсов валют с сервера: cbr.ru")
DO WHILE !poActiveSheet.APPLICATION.Cells[ 1 , 1 ].TEXT = "Дата" AND SECONDS() - nStart < 20
ENDDO
clear_wait()
CREATE CURSOR tmpCurses(dCusrDate d, nCurs N( 17 , 4 ))
FOR i = 2 TO ta.last_date - ta.first_date + 2
IF EMPTY(ALLTRIM(poActiveSheet.APPLICATION.Cells[i, 1 ].TEXT))
LOOP
ENDIF
pdCusrDate = IIF(ConvPossible(VARTYPE(poActiveSheet.APPLICATION.Cells[i, 1 ].VALUE), "D"),;
VarToVar(poActiveSheet.APPLICATION.Cells[i, 1 ].VALUE, "D"), {})
pdCurs = IIF(ConvPossible(VARTYPE(poActiveSheet.APPLICATION.Cells[i, 3 ].VALUE), "N"),;
VarToVar(poActiveSheet.APPLICATION.Cells[i, 3 ].VALUE, "N"), 0 )
IF !EMPTY(pdCusrDate) AND !EMPTY(pdCurs)
INSERT INTO tmpCurses(dCusrDate, nCurs) VALUES (pdCusrDate, pdCurs)
ENDIF
NEXT i
poExcel.DisplayAlerts = .F.
poExcel.QUIT
* msgbox("!")
SELECT tmpCurses
SCAN
sbor_sql(GN_SERVERTYPE, "Select * from spsval where date_doc = ?tmpCurses.dCusrDate and kod_val = ?ta.kod_sch", "tmpSpsval")
IF RECCOUNT("tmpSpsval") = 0 THEN
AddNewRec("Spsval", "Item", "kod_val", ta.kod_sch, "date_doc", tmpCurses.dCusrDate, "kurs", tmpCurses.nCurs)
ELSE
IF tmpCurses.nCurs <> tmpSpsval.kurs THEN
sbor_sql( 0 , "Update Spsval set kurs = tmpCurses.nCurs where item = tmpSpsval.item")
sbor_sql(GN_SERVERTYPE, "Update Spsval set kurs = ?tmpCurses.nCurs where item = ?tmpSpsval.item")
ENDIF
ENDIF
ENDSCAN
RETURN .T.
ENDFUNC
|
|
|
