请问如何把本地文件用ado.steam写入数据库

[jinjun001]

我用ado.steam的loadfromfile读出文件到steam中，然后写入数据库，但读出写回硬盘后不是原来的文件。请问是否需要将读出的文件进行一下处理。我想可能是读出的文件包含了其他信息吧，不仅仅是文件本身。

[tztz520]

up

• 打赏
• 举报

回复 赞

[daisy8675]

Public Sub DisplayData_Employees()

Dim fso As New FileSystemObject

On Error Resume Next

Screen.MousePointer = vbHourglass

If mobjRst.RecordCount <> 0 Then
If Not IsNull(mobjRst!LastName) Then txtField(0) = mobjRst!FirstName Else txtField(0) = ""
If Not IsNull(mobjRst!FirstName) Then txtField(1) = mobjRst!LastName Else txtField(1) = ""
If Not IsNull(mobjRst!Title) Then txtField(2) = mobjRst!Title Else txtField(2) = ""
If Not IsNull(mobjRst!ReportsTo) Then txtField(3) = mobjRst!ReportsTo Else txtField(3) = ""
If Not IsNull(mobjRst!HireDate) Then txtField(4) = mobjRst!HireDate Else txtField(4) = ""
If Not IsNull(mobjRst!Extension) Then txtField(5) = mobjRst!Extension Else txtField(5) = ""
If Not IsNull(mobjRst!Address) Then txtField(6) = mobjRst!Address Else txtField(6) = ""
If Not IsNull(mobjRst!City) Then txtField(7) = mobjRst!City Else txtField(7) = ""
If Not IsNull(mobjRst!Region) Then txtField(8) = mobjRst!Region Else txtField(8) = ""
If Not IsNull(mobjRst!PostalCode) Then txtField(9) = mobjRst!PostalCode Else txtField(9) = ""
If Not IsNull(mobjRst!Country) Then txtField(10) = mobjRst!Country Else txtField(10) = ""
If Not IsNull(mobjRst!HomePhone) Then txtField(11) = mobjRst!HomePhone Else txtField(11) = ""
If Not IsNull(mobjRst!Notes) Then txtField(12) = mobjRst!Notes Else txtField(12) = ""
If Not IsNull(mobjRst!TitleOfCourtesy) Then txtField(13) = mobjRst!TitleOfCourtesy Else txtField(13) = ""
If Not IsNull(mobjRst!BirthDate) Then txtField(14) = mobjRst!BirthDate Else txtField(14) = ""
If Not IsNull(mobjRst!PhotoPath) Then txtPhoto = mobjRst!PhotoPath Else txtPhoto = ""

If Not IsNull(mobjRst!photo) Then

mblnPhotoExist = True

' 取得暫存檔名稱。暫存檔名稱是使用 GetGUID 函數產生。
mstrFileName_Picture = App.Path & "\" & basGUID.GetGUID & ".tmp"

' 設定 Stream Object 空間。
Set mobjStream = New ADODB.Stream

With mobjStream

' 指明儲存在資料串流物件的資料型態。
.Type = adTypeBinary

' 開啟資料串流物件。
.Open

' 將二進位資料附加到資料串流。
.Write mobjRst.Fields("photo").Value

' 從資料串流物件中將資料保存成一檔案。
.SaveToFile mstrFileName_Picture, adSaveCreateOverWrite

End With

' 調整圖片。
Call PhotoAdjustment

' 複製一個專供瀏覽用的暫存檔。
' 新增資料錄與更新資料錄皆是使用「瀏覽用暫存檔」。
fso.CopyFile mstrFileName_Picture, mstrFileName_View, True

' 刪除暫除檔。
fso.DeleteFile mstrFileName_Picture, True

Else
mblnPhotoExist = False
imgView2.Visible = False
End If
End If

Screen.MousePointer = vbDefault

Set fso = Nothing
Set mobjStream = Nothing

End Sub
2.1 存入記錄

請對照 問題 357：如何製作圖片資料庫 (圖片放置於資料庫，使用 GetChunk / AppendChunk 存取)， 讀者一定發現程式碼減肥非常多，而且容易理解。只較 DAO 存入方式多上幾列程式碼而己。

Private Sub InsertData_Employees()

On Error GoTo ErrorHandle

' 異動開始。
mobjConn.BeginTrans

' 增加一筆空白記錄。
mobjRst.AddNew

' 登錄資料錄至空白記錄。
mobjRst!LastName = txtField(0)
mobjRst!FirstName = txtField(1)
If txtField(2) <> "" Then mobjRst!Title = txtField(2) Else mobjRst!Title = ""
If txtField(3) <> "" Then mobjRst!ReportsTo = txtField(3) Else mobjRst!ReportsTo = Null
If txtField(4) <> "" Then mobjRst!HireDate = txtField(4) Else mobjRst!HireDate = Null
If txtField(5) <> "" Then mobjRst!Extension = txtField(5) Else mobjRst!Extension = ""
If txtField(6) <> "" Then mobjRst!Address = txtField(6) Else mobjRst!Address = ""
If txtField(7) <> "" Then mobjRst!City = txtField(7) Else mobjRst!City = ""
If txtField(8) <> "" Then mobjRst!Region = txtField(8) Else mobjRst!Region = ""
If txtField(9) <> "" Then mobjRst!PostalCode = txtField(9) Else mobjRst!PostalCode = ""
If txtField(10) <> "" Then mobjRst!Country = txtField(10) Else mobjRst!Country = ""
If txtField(11) <> "" Then mobjRst!HomePhone = txtField(11) Else mobjRst!HomePhone = ""
If txtField(12) <> "" Then mobjRst!Notes = txtField(12) Else mobjRst!Notes = ""
If txtField(13) <> "" Then mobjRst!TitleOfCourtesy = txtField(13) Else mobjRst!TitleOfCourtesy = Null
If txtField(14) <> "" Then mobjRst!BirthDate = txtField(14) Else mobjRst!BirthDate = Null
If txtPhoto <> "" Then mobjRst!PhotoPath = txtPhoto Else mobjRst!PhotoPath = ""

'------------------------------------------------
' G0 大型二進制資料如圖形之處理
'------------------------------------------------
If mblnPhotoExist Then

' 設定 Stream Object 空間。
Set mobjStream = New ADODB.Stream

With mobjStream

' 指明儲存在資料串流物件的資料型態。
.Type = adTypeBinary

' 開啟資料串流物件。
.Open

' 將檔案內容載入資料串流物件。
.LoadFromFile mstrFileName_View

' 從資料串流讀取二進位資料。
mobjRst.Fields("Photo").Value = .Read

End With
Else
mobjRst.Fields("Photo").Value = Null
End If

' 將該記錄寫入資料庫。
mobjRst.Update

' 異動結束。
mobjConn.CommitTrans

ExitSub:

Set mobjStream = Nothing
Exit Sub

ErrorHandle:
mobjConn.RollbackTrans
MsgBox Err.Description
Resume ExitSub

End Sub

• 打赏
• 举报

回复 赞

[taosihai1only]

up

• 打赏
• 举报

回复 赞

[taosihai1only]

daisy8675(莫依)
怎么这么厉害，刚才四个角，怎么就变成两个星了！

• 打赏
• 举报

回复 赞

[wumy_ld]

'存储文件到数据库
Public Function WriteToDB(ByRef col As ADODB.Field, ByVal FileName As String) As Boolean
On Error GoTo ErrMsg
Dim mStream As ADODB.Stream
Set mStream = New ADODB.Stream

WriteToDB = False
mStream.Type = adTypeBinary
mStream.Open
mStream.LoadFromFile FileName
col.Value = mStream.Read

mStream.Close
Set mStream = Nothing
WriteToDB = True
Exit Function
ErrMsg:
MsgBox "存储文件到数据库时出现错误．" & vbCrLf & Err.Description, vbExclamation + vbOKOnly, "提示"
End Function

'设置临时文件
Public Function ReadDB(col As ADODB.Field, ByRef imgFile As String) As Boolean
On Error GoTo ErrRead
Dim mStream As New ADODB.Stream
ReadDB = False

If col.ActualSize < 200 Then Exit Function

mStream.Type = adTypeBinary
mStream.Open
mStream.Write col.Value
mStream.SaveToFile imgFile, adSaveCreateOverWrite
ReadDB = True
Exit Function
ErrRead:
MsgBox "设置临时文件时出现错误:" & vbCrLf & Err.Description, vbInformation, "提示"
ReadDB = False
End Function

'应用实例：
'把图片写入到数据库
strSQL = "select * from " & strTable _
& " where BBID='" & strBBID & "'" _
& " and ReportIndex=" & objControl.Index _
& " and ReportType=" & WPhoto
Set rsTemp = New ADODB.Recordset
rsTemp.Open strSQL, GCon, adOpenDynamic, adLockOptimistic
WriteToDB rsTemp("ReportPhoto"), mstrTempFile
rsTemp.Update
rsTemp.Close

• 打赏
• 举报

回复 赞

[zjcxc]

'VB/VBA中实现数据库中的文件存取

'*************************************************************************
'**
'** 使用 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

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

'读取文件到内容
Set iStm = New ADODB.Stream
With iStm
.Type = adTypeBinary '二进制模式
.Open
.LoadFromFile "c:\test.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=\\xz\c$\Inetpub\zj\zj\zj.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
.Open
.Write iRe("img")
.SaveToFile "c:\test.doc"
End With

'关闭对象
iStm.Close
End If

iRe.Close
End Sub

• 打赏
• 举报

回复 赞

[射天狼]

Option Explicit

Dim cn As New ADODB.Connection, rs As New ADODB.Recordset

'保存
Private Sub Command1_Click()
Dim bteContent() As Byte

Open "C:\aa.bmp" For Binary Access Read As #1
bteContent = InputB(LOF(1), #1)
Close #1

If rs.State = adStateOpen Then rs.Close
rs.Open "select * from tablename", cn, adOpenDynamic, adLockPessimistic
rs.AddNew
rs!Name = "张三"
rs!AGE = 22
rs!SEX = "男"
rs.Fields("PHOTO").AppendChunk bteContent
rs.Update

Erase bteContent
End Sub

'打开
Private Sub Command2_Click()
Dim bteContent() As Byte
If rs.State = adStateOpen Then rs.Close
rs.Open "select * from tablename", cn, adOpenForwardOnly, adLockReadOnly
bteContent = rs.Fields("PHOTO").GetChunk(rs.Fields("PHOTO").ActualSize)

Open "C:\aa.bmp" For Binary Access Write As #1
Put #1, , bteContent
Close #1
Image1.Picture = LoadPicture("C:\aa.bmp")
End Sub

Private Sub Form_Load()
On Error GoTo Errhandle
cn.ConnectionString = "Driver={SQL Server};SERVER=DataServer;DATABASE=zxzx;UID=information;PWD=information*&#"
cn.Open

Exit Sub
Errhandle:
MsgBox Err.Description, vbExclamation
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
On Error Resume Next
rs.Close
Set rs = Nothing
cn.Close
Set cn = Nothing
End Sub

• 打赏
• 举报

回复 赞

[yoki]

'假设数据库中对应的表为tb1，
'结构如：create tabel tb1(id int identity(1,1),WordValue image)
'那么我就可以将word文档存入此表的WordValue字段

Dim cn As New ADODB.Connection
Dim rs As New ADODB.Recordset
Dim stm As ADODB.Stream

Private Sub SaveDocToDB(cn As ADODB.Connection)
On Error GoTo EH
Set stm = New ADODB.Stream
rs.Open "select WordValue from tbl", cn, adOpenKeyset, adLockOptimistic
CommonDialog1.ShowOpen
Text1.Text = CommonDialog1.FileName

With stm
.Type = adTypeBinary
.Open
.LoadFromFile CommonDialog1.FileName
End With
With rs
.AddNew
.Fields("wordValue") = stm.Read
.Update
End With
rs.Close
Set rs = Nothing
Exit Sub
EH: MsgBox Err.Description, vbInformation, "Error"
End Sub


Private Sub LoadDcFromDB(cn As ADODB.Connection)
'读出
On Error GoTo EH
Dim strTemp As String
Set stm = New ADODB.Stream
strTemp = "c:\temp.doc" '临时文件,用来保存读出的文档
rs.Open "select WordValue from tbl where id=1", cn, , , adCmdText
With stm
.Type = adTypeBinary
.Open
.Write rs("WordValue")
.SaveToFile strTemp, adSaveCreateOverWrite
.Close
End With
Set stm = Nothing
rs.Close
Set rs = Nothing
Exit Sub
EH: MsgBox Err.Description, vbInformation, "Error"
End Sub

• 打赏
• 举报

回复 赞