get Data from THS

Private Sub CommandButton1_Click()



Dim sht As Worksheet
Dim a, b, c, n As Integer
Dim m, x As Long

Dim txt, fdir, tCode As String
Set sht = ThisWorkbook.ActiveSheet
Set stream = CreateObject("adodb.stream")

tCode = ThisWorkbook.ActiveSheet.Cells(1, 1)
stream.Mode = 3
stream.Type = 1
stream.Open

'弹出目录选择对话框时，请选到同花顺的history目录~~
Set FD = Application.FileDialog(4)
With FD
.AllowMultiSelect = False
.Show
End With
If FD.SelectedItems.Count > 0 Then fdir = FD.SelectedItems(1)


txt = fdir + "\shase\day\" & tCode & ".day"

If Dir(txt) = "" Then
txt = fdir + "\sznse\day\" & tCode & ".day"
If Dir(txt) = "" Then
MsgBox ("没有找到此票数据！")
Exit Sub
End If
End If
stream.LoadFromFile (txt)

txt = stream.read
m = 0
n = (2 * Len(txt) - 64) / 48
For a = 0 To n - 1
For b = 1 To 7
For c = 1 To 4
x = AscB(MidB(txt, 48 * a + 4 * (b - 1) + c + 64, 1))
If c = 1 Then m = m + x
If c = 2 Then m = m + x * 256
If c = 3 Then m = m + x * 256 * 256
If c = 4 Then If b = 1 Then m = m + x * 256 * 256 * 256 Else m = m + (x And 15) * 256 * 256 * 256
Next c
If b = 1 Then
Cells(a + 2, b).Value = Left(m, 4) + "-" + Mid(m, 5, 2) + "-" + Right(m, 2)
Else
If b = 6 Or b = 7 Then Cells(a + 2, b).Value = m / 10 Else Cells(a + 2, b).Value = m / 1000
End If
m = 0
Next b
Next a


End Sub


VB/VBA中实现数据库中的文件存取2009年11月03日 星期二 02:04 P.M.'VB/VBA中实现数据库中的文件存取'示例数据库为ACCESS数据库,用SQL数据库的话,只需要改连接字符串
'
'*************************************************************************
'**
'** 使用 ADODB.Stream 保存/读取文件到数据库
'** 引用 Microsoft ActiveX Data Objects 2.5 Library 及以上版本
'**
'** ----- 数据库连接字符串模板 ---------------------------------------
'** ACCESS数据库
'** iConcStr = "Provider=Microsoft.Jet.OLEDB.4.0;Persist Security Info=False" & _
'** ";Data Source=数据库名"
'**
'** SQL数据库
'** iConcStr = "Provider=SQLOLEDB.1;Persist Security Info=True;" & _
'** "User ID=用户名;Password=密码;Initial Catalog=数据库名;Data Source=SQL服务器名"
'**
'*************************************************************************
'
'保存文件到数据库中
Sub s_SaveFile()
Dim iStm As ADODB.Stream
Dim iRe As ADODB.Recordset
Dim iConcStr As String

'ACCESS数据库的连接字符串
iConcStr = "Provider=Microsoft.Jet.OLEDB.4.0;Persist Security Info=False" & _
";Data Source=F:My Documents客户资料1.mdb"

'SQL数据库的连接字符串
iConcStr = "Provider=SQLOLEDB.1;Persist Security Info=True;" & _
"User ID=用户名;Password=密码;Initial Catalog=数据库名;Data Source=SQL服务器名"
'读取文件到内容
Set iStm = New ADODB.Stream
With iStm
.Type = adTypeBinary '二进制模式,如果是用text/ntext字

段保存纯文本数据,则改用 adTypeText
.Open
.LoadFromFile "c: est.doc"
End With

'打开保存文件的表
Set iRe = New ADODB.Recordset
With iRe
.Open "表", iConc, adOpenKeyset, adLockOptimistic
.AddNew '新增一条记录
.Fields("保存文件内容的字段") = iStm.Read
.Update
End With

'完成后关闭对象
iRe.Close
iStm.Close
End Sub'从数据库中读取数据,保存成文件
Sub s_ReadFile()
Dim iStm As ADODB.Stream
Dim iRe As ADODB.Recordset
Dim iConc As String

'数据库连接字符串
iConc = "Provider=Microsoft.Jet.OLEDB.4.0;Persist Security Info=False" & _
";Data Source=\xzc$Inetpubzjzjzj.mdb"

'打开表
Set iRe = New ADODB.Recordset
iRe.Open "tb_img", iConc, adOpenKeyset, adLockReadOnly
iRe.Filter = "id=64" if iRe("img").ActualSize>0 Then '保存到文件
Set iStm = New ADODB.Stream
With iStm
.Mode = adModeReadWrite
.Type = adTypeBinary '二进制模式,如果是用text/ntext字段保存纯文本数据,则改用 adTypeText
.Open
.Write iRe("img")
.SaveToFile "c: est.doc"
End With

'关闭对象
iStm.Close
End If iRe.Close
End Sub