2011-03-29 105 views

回答

1

這是我在一箇舊項目中做到的。您可以剝去進度條的東西,其他的一些東西,但你的想法

Public Sub Upload_file_OLD(lMaterial_ID As Long, strFile_name As String) 
'upload the file to the selected material ID. 
Dim adStream As ADODB.Stream 
Dim rst As ADODB.Recordset 
On Error GoTo Error_trap 

'check if we have an open connection, if we do use it 
Select Case dbCon.State 
    Case adStateOpen 
     'connection is open, do nothing 
    Case adStateConnecting 
     'still conecting wait 
     Do Until dbCon.State = adStateOpen 
      Application.Echo True, "Connection to DB" 
     Loop 
    Case adStateClosed 
     'connection closed, try to open it 
     If Len(strSQL_con_string) = 0 Then 
      Set_SQL_con "MCTS" 
     End If 
     dbCon.ConnectionString = strSQL_con_string 
     dbCon.Provider = "sqloledb" 
     dbCon.Open 
End Select 

Me.acxProg_bar.Value = 0 
Me.acxProg_bar.Visible = True 
Me.Repaint 

Set adStream = New ADODB.Stream 
adStream.Type = adTypeBinary 
adStream.Open 
Me.acxProg_bar.Value = 10 
Me.Repaint 
adStream.LoadFromFile strFile_name 
Me.acxProg_bar.Value = 50 
Me.Repaint 

Set rst = New ADODB.Recordset 
rst.Open "SELECT Material_FS,Material_file_name, Material_size FROM tblMaterials WHERE Material_ID=" & lMaterial_ID, dbCon, adOpenKeyset, adLockOptimistic 
Me.acxProg_bar.Value = 60 
Me.Repaint 
Me.txtFile_size = adStream.Size 
rst.Fields("Material_FS").Value = adStream.Read 
rst.Fields("Material_file_name").Value = GetFileName(strFile_name) 
rst.Fields("Material_size").Value = adStream.Size 
Me.acxProg_bar.Value = 90 
Me.Repaint 
rst.Update 
rst.Close 
dbCon.Close 
Me.acxProg_bar.Value = 0 
Me.acxProg_bar.Visible = False 
Me.Repaint 


Exit Sub 

Error_trap: 

If dbCon Is Nothing = False Then 
    If dbCon.State = adStateOpen Then dbCon.Close 
End If 

DoCmd.Hourglass False 
MsgBox "An error happened in sub Upload_file, error description, " & Err.Description, vbCritical, "MCTS" 

End Sub 
0

我不能讓上面的代碼工作,但我沒有得到這個工作。 SQL Server blob字段是varbinary(max)。

上傳:

Sub TestDocUpload() 
Dim cmd As New ADODB.Command 
Dim st As New ADODB.Stream 

st.Type = adTypeBinary 
st.Open 
st.LoadFromFile "c:\temparea\18572.pdf" 

With cmd 
    .CommandText = "Insert into tbldocuments(docblob, doctype) values (?, ?)" 
    .CommandType = adCmdText 
    .Parameters.Append .CreateParameter("@P1", adLongVarBinary, adParamInput, st.Size, st.Read) 
    .Parameters.Append .CreateParameter("@P2", adVarChar, adParamInput, 50, "CustPO") 

End With 
If cnlocal.State = 0 Then OpenNewLocalConnection 
cmd.ActiveConnection = cnlocal 
cmd.Execute 

End Sub 

檢索:

Sub TestReadDoc() 
Dim myblob() As Byte 
Dim rs As New ADODB.Recordset 

If cnlocal.State = 0 Then OpenNewLocalConnection 
rs.Open "tblDocuments", cnlocal, adOpenForwardOnly, adLockReadOnly 
rs.MoveFirst 
myblob = rs!DocBlob 
Open "c:\temparea\output.pdf" For Binary Access Write As 1 
Put #1, , myblob 
Close #1 

End Sub 
相關問題