将 Access Attachment 数据类型转换为文件系统文件
Convert Access Attachment data type to file system files
我有很多文件作为附件存储在 Access 数据库中。我要将数据移动到 SQL 服务器,为此我需要提取附件并将它们转换为文件系统文件。
此代码段适用于图像和 pdf 文件,但不适用于 Word 或 Excel 等 Office 文档。我认为它与编码有关,但我没有任何线索。有什么想法吗?
Dim dbs As Database
Dim rs As Recordset
Set dbs = CurrentDb
Set rs = dbs.OpenRecordset("table1")
With rs
Do While Not .EOF
Set rsRec = rs.Fields("AttFiles").Value
While Not rsRec.EOF
NameOfFile = "C:\temp\" & rsFil.Fields("FileName")
Open NameOfFile For Binary Access Write As #1
Put #1, , rsRec.Fields("FileData").Value
Close #1
rsRec.MoveNext
Wend
.MoveNext
Loop
End With
rs.Close
dbs.Close
如果File其实是附件类型,那你还不如用Microsoft Access Object Library的Recordset2。像,
Public Sub exportDocument(tableName As String, fieldName As String, uniqueID As Long)
On Error GoTo Err_SaveImage
Dim rsParent As DAO.Recordset2
Dim rsChild As DAO.Recordset2
Dim saveAsName As String
Set rsParent = CurrentDb.OpenRecordset("SELECT " & tableName & ".* " & _
"FROM " & tableName & " WHERE " & tableName & "." & fieldName & " = " & uniqueID)
Set rsChild = rsParent.Fields("fileData").Value
If rsChild.RecordCount <> 0 Then
If Dir(Environ("userprofile") & "\My Documents\tmp\", vbDirectory) <> "." Then MkDir Environ("userprofile") & "\My Documents\tmp\"
saveAsName = Environ("userprofile") & "\My Documents\tmp\" & rsChild.Fields("FileName")
rsChild.Fields("fileData").SaveToFile saveAsName
FollowHyperlink saveAsName
End If
Exit_SaveImage:
Set rsChild = Nothing
Set rsParent = Nothing
Exit Sub
Err_SaveImage:
If Err = 3839 Then
Resume Next
Else
MsgBox "Some Other Error occured!" & vbCrLf & vbCrLf & Err.Number & " - " & Err.Description, vbCritical
Resume Exit_SaveImage
End If
End Sub
以上代码会将文件保存到 saveAsName
中指定的位置。我在 WHERE
条件下有特定的唯一 ID。如果要导出所有文档,可以相应地更改代码,但可能必须遍历记录集。希望对您有所帮助!
我有很多文件作为附件存储在 Access 数据库中。我要将数据移动到 SQL 服务器,为此我需要提取附件并将它们转换为文件系统文件。
此代码段适用于图像和 pdf 文件,但不适用于 Word 或 Excel 等 Office 文档。我认为它与编码有关,但我没有任何线索。有什么想法吗?
Dim dbs As Database
Dim rs As Recordset
Set dbs = CurrentDb
Set rs = dbs.OpenRecordset("table1")
With rs
Do While Not .EOF
Set rsRec = rs.Fields("AttFiles").Value
While Not rsRec.EOF
NameOfFile = "C:\temp\" & rsFil.Fields("FileName")
Open NameOfFile For Binary Access Write As #1
Put #1, , rsRec.Fields("FileData").Value
Close #1
rsRec.MoveNext
Wend
.MoveNext
Loop
End With
rs.Close
dbs.Close
如果File其实是附件类型,那你还不如用Microsoft Access Object Library的Recordset2。像,
Public Sub exportDocument(tableName As String, fieldName As String, uniqueID As Long)
On Error GoTo Err_SaveImage
Dim rsParent As DAO.Recordset2
Dim rsChild As DAO.Recordset2
Dim saveAsName As String
Set rsParent = CurrentDb.OpenRecordset("SELECT " & tableName & ".* " & _
"FROM " & tableName & " WHERE " & tableName & "." & fieldName & " = " & uniqueID)
Set rsChild = rsParent.Fields("fileData").Value
If rsChild.RecordCount <> 0 Then
If Dir(Environ("userprofile") & "\My Documents\tmp\", vbDirectory) <> "." Then MkDir Environ("userprofile") & "\My Documents\tmp\"
saveAsName = Environ("userprofile") & "\My Documents\tmp\" & rsChild.Fields("FileName")
rsChild.Fields("fileData").SaveToFile saveAsName
FollowHyperlink saveAsName
End If
Exit_SaveImage:
Set rsChild = Nothing
Set rsParent = Nothing
Exit Sub
Err_SaveImage:
If Err = 3839 Then
Resume Next
Else
MsgBox "Some Other Error occured!" & vbCrLf & vbCrLf & Err.Number & " - " & Err.Description, vbCritical
Resume Exit_SaveImage
End If
End Sub
以上代码会将文件保存到 saveAsName
中指定的位置。我在 WHERE
条件下有特定的唯一 ID。如果要导出所有文档,可以相应地更改代码,但可能必须遍历记录集。希望对您有所帮助!