将超链接文件保存到文件夹 vba

Question

我有一个零件数据库，我们一直在使用 Access 2010 附件功能将 PDF 附加到每个零件号。我有一些工作代码可以完成我想做的事情，即查询给定的零件列表并将附加的 PDF 文件保存到文件夹中。我现在将 [PDF] 列更改为超链接列，因为我担心我最终会超过 3GB 的限制。

有没有办法可以修改此代码以使用超链接字段而不是附件类型字段？

这里的最终目标是为我们的客户制作包含所有部分文档 (PDF) 的 CD。

Private Sub Command32_Click()
'this creates a folder for me
If Dir([filePath] & [newFolder], vbDirectory) = "" Then
MkDir [filePath] & [newFolder]
Else

MsgBox ("Folder:" & " " & [newFolder] & " " & "already Exists")
Exit Sub
End If

'code to loop through present list and save attached files to the new folder

Dim db As DAO.Database
Dim rsParent As DAO.Recordset2
Dim rsChild As DAO.Recordset2

Set db = CurrentDb
Set rsParent = Me.Recordset

With rsParent
.MoveFirst 'This ensures that regardless of your current record, the loop will start with the first record

Do While Not .EOF

Set rsChild = rsParent.Fields("pdf").Value

    With rsChild
    Do While Not .EOF
        If rsChild.RecordCount <> 0 Then
            rsChild.OpenRecordset
            rsChild.Fields("FileData").SaveToFile ([filePath] & [newFolder])
            Me.Refresh
            .MoveNext
     Else
        .MoveNext
     End If
    Loop
  End With

.MoveNext
Loop
End With
Exit_SaveImage:

Exit Sub
' error stuff
Err_SaveImage:
If Err = 3839 Then
    MsgBox ("All Done")
    Resume Next
Else
    MsgBox "There's been an error!", Err.Number, Err.DESCRIPTION
    Resume Exit_SaveImage
End If
End Sub

Answer 1

假设包含您的文件 URL 的字段名为 FileURL ，更改

rsChild.Fields("FileData").SaveToFile ([filePath] & [newFolder])

到

Filecopy rsChild.Fields("FileURL"), [filePath] & [newFolder]

注意：将 FileURL 字段定义为包含完整限定文件名的普通字符串，而不是 Hyperlink。

希望对你有帮助