excel和access : No 1 - 使用vba读写

这两天完成了一个vba小工具，交易时间能每隔一秒读一次excel期权套利模板里面的某个页面的数据，存到access的mdb里面。

重放的时候选好时间后从access里面读出。

总共300多行，主要就是存取数据，以及定时调用等。

研究存储耗费了大量时间，定时调用开始写了个while程序直接挂掉，最后发现得用自调用，读数据的时候总报错，要搞成time=“'20140331 12:21:15'”的形式才行。（这是因为自己抄了个sqlDatetime的函数导致的）

一句话，VBA很蛋疼。

==========

主要代码：

1. 读数据

Sub read_options()

Dim cnn As New ADODB.Connection
Dim rs As New ADODB.Recordset
Dim strsql As String
cnn.Open "Provider=Microsoft.ACE.OLEDB.12.0;User ID=Admin;Data Source=" & ThisWorkbook.Path & "\test.mdb;Mode=ReadWrite;Extended Properties='';Jet OLEDB:System"

'1.读数据
Dim his_date As Date
his_date = Worksheets("quote").Range("Y10")
his_date_str = sqlDateTime(his_date)
strsql = "select top 1 time from record where time<""" & his_date_str & """ order by ID desc;"
rs.Open strsql, cnn, adOpenKeyset, 2 '打开记录集

Dim ldate As String
ldate = rs.Fields(0)

rs.Close

strsql1 = "select * from quote where time=""" & ldate & """ order by strike_a asc;"
rs.Open strsql1, cnn, adOpenKeyset, 1 '打开记录集

'2. 复制数据
fieldCount = rs.Fields.Count

rs.MoveFirst
idx = 0
Set Rng = Sheet2.Range("A3")
Do While Not rs.EOF
idx = idx + 1

For i = 0 To fieldCount - 1
If i = 0 Or i = (fieldCount - 1) Then GoTo nextI

Rng.Offset(idx, i - 1) = rs.Fields(i).Value
nextI:
Next i

rs.MoveNext
Loop

rs.Close
Set rs = Nothing


End Sub

 

2. 存期权数据

'存储期权
Sub save_options()

Dim cnn As New ADODB.Connection
Dim rs As New ADODB.Recordset
Dim strsql As String

'确定是否需要存储
cnn.Open "Provider=Microsoft.ACE.OLEDB.12.0;User ID=Admin;Data Source=" & ThisWorkbook.Path & "\test.mdb;Mode=ReadWrite;Extended Properties='';Jet OLEDB:System"
strsql1 = "select top 1 time from record order by ID desc;"
rs.Open strsql1, cnn, adOpenKeyset, 2 '打开记录集

Dim ldate As String
ldate = rs.Fields(0)

Dim lvalue As String

lvalue = sqlDateTime(Now())

Dim temp_var As Variant
temp_var = "time"
rs.AddNew temp_var, lvalue

rs.Close

strsql = "select * from quote;"
rs.Open strsql, cnn, adOpenKeyset, 2 '打开记录集

'1. 确定期权需要存储的范围
first_row = 4
last_row = Sheets("quote").Range("a65536").End(xlUp).Row
' column from a to v
'Debug.Print first_row, last_row

'2. 循环存储
Dim fieldsArray(22) As Variant
fieldsArray(0) = "Strike_a"
fieldsArray(1) = "Position_call_a"
fieldsArray(2) = "Volume_call_a"
fieldsArray(3) = "Bid1_call_a"
fieldsArray(4) = "Last_call_a"
fieldsArray(5) = "Ask1_call_a"
fieldsArray(6) = "Bid1_put_a"
fieldsArray(7) = "Last_put_a"
fieldsArray(8) = "Ask1_put_a"
fieldsArray(9) = "Volume_put_a"
fieldsArray(10) = "Positon_put_a"
fieldsArray(11) = "Strike_b"
fieldsArray(12) = "Positon_call_b"
fieldsArray(13) = "Volume_call_b"
fieldsArray(14) = "Bid1_call_b"
fieldsArray(15) = "Last_call_b"
fieldsArray(16) = "Ask1_call_b"
fieldsArray(17) = "Bid1_put_b"
fieldsArray(18) = "Last_put_b"
fieldsArray(19) = "Ask1_put_b"
fieldsArray(20) = "Volume_put_b"
fieldsArray(21) = "Position_put_b"
fieldsArray(22) = "time"

Dim values(22) As Variant

For i = first_row To last_row
arr1 = Application.Transpose(Sheets("quote").Range("A" & i & ":" & "V" & i))
arr2 = Application.Transpose(Application.Index(arr1, , 1))
For j = 1 To 22
values(j - 1) = arr2(j)
Next
values(22) = lvalue
rs.AddNew fieldsArray, values
Next
'3. 关闭连接
rs.Close
cnn.Close
Set rs = Nothing
Set cnn = Nothing
End Sub

 

reference:

http://www.cnblogs.com/dxy1982/tag/VBA/ 真心不错

还有很多，但是都很零散，没记录下来