MS Access VBA将PDF文件移动到记录集中指定的文件夹

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