Question

我编写了代码来从文件夹中提取特定文件，将其插入附件字段（local_attachment）并在表TEMP_attachment中创建新记录。我试图从文件夹中提取所有文件并让它们各自成为表中的新记录但是我一直在遇到问题，我要么拉所有文件而且它们都进入一条记录，否则它就赢了拉任何。谢谢你的帮助!!!
这是我的代码：

> Function MedianIf(rng As Range, Criteria As Variant) As Variant
>     Dim cell As Range
>     Dim ar() As Variant
>     Dim i    As Long
>     
>     With WorksheetFunction
>         If .CountIf(rng, Criteria) = 0 Then
>             MedianIf = CVErr(2036) '-- #NUM!
>         Else
>             ReDim ar(1 To rng.Cells.Count)
>             For Each cell In rng.Cells
>                 If .CountIf(cell, Criteria) = 1 Then
>                     i = i + 1
>                     ar(i) = cell.Value
>                 End If
>             Next
>             MedianIf = .Median(ar)
>         End If
>     End With End Function

Answer 1

我的代码问题可以解决，我采用更有条理的方法。在我看来，你需要找到文件夹中的所有文件，为每个文件添加一条记录，为文件添加附件记录，将文件数据读入新记录，并为父记录生成唯一键。

不要试图一次性完成所有事情，而是让它们分解并以相反的顺序进行，所以我们首先处理最小的问题：

首先，让我们弄清楚我们将如何生成密钥。最简单的方法是使用自动编号字段。我会假设这是你将使用的解决方案，而不是烹饪出更高档的东西。这将使DoCmd.RunSQL变得不必要并简化整个操作。

其次，编写一个例程，将一个文件添加到数据库中的一个记录中，并确保它正常工作。我的建议是为主表创建记录集的参数和文件的路径，就像这样（我没有测试过，这将是你的工作。我已经添加了错误处理程序来帮助你解决任何问题问题）：

Private Sub AddFileAttachment(ByRef rs As DAO.Recordset, ByVal sPath As String)

    Dim rsAttachments As DAO.Recordset

    On Error Goto EH

    With rs
        '(this will generate a new Autonumber in the main table)
        .AddNew 

        'this will create a new attachment in the field and add it
        Set rsAttachments = .Fields("local_attachemnt").Value
        With rsAttachments
            .AddNew 
            .Fields("FileData").LoadFromFile sPath 
            .Update
            .Close
        End With

        'this is what adds the main record 
        .Update
    End With

EH:
    With Err
        MsgBox .Number & vbcrlf & .Source & vbCrLf & .Description
    End With
FINISH:
    If Not rs Is Nothing Then
        rs.Close
        Set rs = Nothing
    End If
    If Not rsAttachments Is Nothing Then
        rsAttachments.Close
        Set rsAttachments = Nothing
    End If

End Sub

并称之为：

Private Sub cmdTest_Click()
    Dim db As DAO.Database
    Dim rs As DAO.Recordset

    On Error Goto EH

    Set db = CurrentDb
    Set rs = db.OpenRecordset("TEMP_Attachment")
    AddFileAttachment rs, "C:\dev\test_file2.txt"

    Goto FINISH

EH:
    With Err
        MsgBox .Number & vbcrlf & .Source & vbCrLf & .Description
    End With
FINISH:
    rs.Close
End Sub

重要提示！在继续之前完善第一个例程。你应该测试它，直到你知道它一遍又一遍地工作。您应该可以单击它所连接的按钮10次，每次都会获得附有文件的新记录。

一旦您知道这是有效的，您就可以编写为您附加的每个文件调用它的主例程。我不会在这里包含它，但会建议研究FileSystemObject。您应该能够找到很多关于如何获取文件夹中所有文件的vba示例。你可以循环遍历它们，并按照上面测试中调用的方式调用每个文件的例程，传入open记录集。

访问VBA代码以从文件夹中提取所有文件并将其插入表中的单独附件字段

1 个答案: