Infopath附件领域;在SQL Server中提交

时间:2010-04-19 10:22:18

标签: sql-server vba infopath

有没有办法使用VBA从表单到SQL Server列获取附件?有一些关于encodind和解码附件的例子,但是这种情况呢?

SQL Server是否以某种方式支持附件?

提前致谢, 太阳

1 个答案:

答案 0 :(得分:0)

您可以在VarBinary(Max)列中将文件存储在SQL Server中。这将存储你放在那里的东西,以便你以后可以检索它。如果您使用的是SQL Server 2008,您还可以使用非常强大的文件流功能,并以完全相同的方式工作

以下是我所拥有的访问/ VBA项目中的一些代码,它将下载存储在SQL Server中的文件并将其保存到磁盘

Public Sub Download_file(lMaterial_ID As Long, strSave_folder As String)
'Download the file lMaterial_ID and save it 
Dim adStream As ADODB.Stream
Dim rst As ADODB.Recordset
On Error GoTo Error_trap
On Error GoTo 0
'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
        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


Set rst = New ADODB.Recordset
rst.Open "SELECT Material_FS, Material_file_name FROM tblMaterials WITH (NOLOCK) WHERE Material_ID=" & lMaterial_ID, dbCon, adOpenForwardOnly, adLockReadOnly
Me.acxProg_bar.Value = 60
Me.Repaint
If IsNull(rst.Fields("Material_FS").Value) = False Then
    adStream.Write rst.Fields("Material_FS").Value
    Me.acxProg_bar.Value = 80
    Me.Repaint
    adStream.SaveToFile strSave_folder & "\" & rst.Fields("Material_file_name").Value, adSaveCreateOverWrite
End If
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 Download_file, error description, " & Err.Description, vbCritical, "MCTS"
Me.acxProg_bar.Value = 0
Me.acxProg_bar.Visible = False
Me.Repaint
End Sub