MS Access VBA将PDF文件移动到记录集中指定的文件夹
问题描述:
对于知道这一点的人来说,我认为应该非常简单。我有一个Access表,其中列出了特定文件夹中的PDF名称以及它们通过唯一参考号链接的代理。一个Agent有很多PDF。MS Access VBA将PDF文件移动到记录集中指定的文件夹
我想要做的是让用户按下表格上的按钮,并将PDF文件复制到相应的代理文件夹中。我的代码有点混乱,我从我们这里的代码片段和谷歌代码中拼凑了一些代码。
它创建文件夹,但留下一些空的。它也仅移动每个代理的一个PDF。我猜我需要一个循环,但我不知道在哪里放一个。
Private Sub Command2_Click()
Dim intCurrPos As Integer, intNextPos As Integer, intLength As Integer
Dim strSlash As String, strFolder As String, strRSFolder As String
Dim fs, cf, x
Dim db As DAO.Database
Dim rs As DAO.Recordset
On Error GoTo Err_CreateFolder
Set db = CurrentDb
Set rs = db.OpenRecordset("tbl_PDF_Agent", dbOpenDynaset, dbReadOnly)
On Error Resume Next
Set fs = CreateObject("Scripting.FileSystemObject")
strSlash = "\"
intCurrPos = 4
strFolder = CurrentProject.Path
intLength = Len(strFolder)
If intLength > 3 Then
Do
intNextPos = InStr(intCurrPos, strFolder, strSlash)
intCurrPos = intNextPos + 1
If intNextPos > 0 Then
If fs.FOLDEREXISTS(Left(strFolder, intNextPos - 1)) = False Then
Set cf = fs.CreateFolder(Left(strFolder, intNextPos - 1))
End If
Else
If fs.FOLDEREXISTS(Left(strFolder, intLength)) = False Then
Set cf = fs.CreateFolder(Left(strFolder, intLength))
End If
End If
Loop Until (intNextPos = 0)
End If
While Not rs.EOF
strRSFolder = strFolder & "\" & rs!Agent
Set fs = CreateObject("Scripting.FileSystemObject")
If fs.FOLDEREXISTS(strRSFolder) = True Then
'MsgBox "'" & strRSFolder & "' already exists!"
Else
Set cf = fs.CreateFolder(strRSFolder) & "\"
If fs.FOLDEREXISTS(strRSFolder) = True Then
fs.CopyFile CurrentProject.Path & "\" & rs!FullName, _
(strRSFolder) & "\" & rs!FullName
Else
'MsgBox "'" & strRSFolder & "' was not successfully created!"
End If
End If
rs.MoveNext
Wend
MsgBox "Done"
Exit Sub
任何人都可以给的指针会很棒。
答
我对你的目标有点不清楚,但是如果你想把所有的PDF文件转移到一个特定的代理文件夹中,假设完整的UNC位置的PDF文件的初始和目的地路径都存储在表中两列,您可以遍历表中的这些记录,使用VB Name函数并将源文件夹和目标文件夹字符串传递给记录集中的函数。这是一些伪代码(Field1是源UNC位置,Field2是目标UNC位置):
Do While Not Recordset.EOF
Name Recordset!Field1 AS Recordset!Field2
Recordset.MoveNext
Loop