将Access Attachment数据类型转换为文件系统文件

时间:2015-05-18 13:35:32

标签: sql-server vba ms-access character-encoding access-vba

我有很多文件存储为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

1 个答案:

答案 0 :(得分:4)

如果文件实际上是附件类型,那么您也可以使用Microsoft Access对象库的Recordset2。像,

/**
 * Magento
 *
 * NOTICE OF LICENSE
 *
 * This source file is subject to the Academic Free License (AFL 3.0)
 * that is bundled with this package in the file LICENSE_AFL.txt.
 * It is also available through the world-wide-web at this URL:
 * http://opensource.org/licenses/afl-3.0.php
 * If you did not receive a copy of the license and are unable to
 * obtain it through the world-wide-web, please send an email
 * to license@magento.com so we can send you a copy immediately.
 *
 * DISCLAIMER
 *
 * Do not edit or add to this file if you wish to upgrade Magento to newer
 * versions in the future. If you wish to customize Magento for your
 * needs please refer to http://www.magento.com for more information.
 *
 * @category    design
 * @package     rwd_default
 * @copyright   Copyright (c) 2006-2014 X.commerce, Inc. (http://www.magento.com)
 * @license     http://opensource.org/licenses/afl-3.0.php  Academic Free License (AFL 3.0)
 */

Checkout.prototype.gotoSection = function (section, reloadProgressBlock) {
    // Adds class so that the page can be styled to only show the "Checkout Method" step
    if ((this.currentStep == 'login' || this.currentStep == 'billing') && section == 'billing') {
        $j('body').addClass('opc-has-progressed-from-login');
    }

    if (reloadProgressBlock) {
        this.reloadProgressBlock(this.currentStep);
    }
    this.currentStep = section;
    var sectionElement = $('opc-' + section);
    sectionElement.addClassName('allow');
    this.accordion.openSection('opc-' + section);

    // Scroll viewport to top of checkout steps for smaller viewports
    if (Modernizr.mq('(max-width: ' + bp.xsmall + 'px)')) {
        $j('html,body').animate({scrollTop: $j('#checkoutSteps').offset().top}, 800);
    }

    if (!reloadProgressBlock) {
        this.resetPreviousSteps();
    }
}

上述代码会将文件保存到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条件下有特定的唯一ID。如果要导出所有文档,可以相应地更改代码,但可能必须遍历记录集。我希望这有帮助!