对于那些知道这一点的人,我认为应该很简单。我有一个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
任何人都能指出的任何指示都会很棒。
答案 0 :(得分:0)
我有点不清楚您的目标是什么,但是如果您想要将所有PDF转移到特定代理商的文件夹,假设PDF的完整UNC位置'初始路径和目标路径存储在两列的表中,您可以遍历表中的那些记录,使用VB Name函数并将源和目标文件夹字符串传递给记录集中的函数。这里有一些伪代码(Field1是源UNC位置,Field2是目标UNC位置):
Do While Not Recordset.EOF
Name Recordset!Field1 AS Recordset!Field2
Recordset.MoveNext
Loop