Question

对于那些知道这一点的人，我认为应该很简单。我有一个Access表，列出了特定文件夹中的PDF名称，以及它们通过唯一引用号链接到的代理。一个代理有很多PDF。

我想要做的是让用户按下表单上的按钮，然后将PDF复制到相应的代理文件夹中。我的代码有点像混搭，我把它们拼凑在一起，从我们这里的代码片段和google fu中填充。

它会创建文件夹，但会将其中一些文件留空。它还为每个代理移动一个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

任何人都能指出的任何指示都会很棒。

Answer 1

我有点不清楚您的目标是什么，但是如果您想要将所有PDF转移到特定代理商的文件夹，假设PDF的完整UNC位置＆＃39;初始路径和目标路径存储在两列的表中，您可以遍历表中的那些记录，使用VB Name函数并将源和目标文件夹字符串传递给记录集中的函数。这里有一些伪代码（Field1是源UNC位置，Field2是目标UNC位置）：

Do While Not Recordset.EOF
    Name Recordset!Field1 AS Recordset!Field2
Recordset.MoveNext
Loop

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

1 个答案: