Question

我正在使用Access 2013并且有一个查询＆＃34; qryMatchingStyle＆＃34;和字段＆＃34; FilePath＆＃34;包含从中复制图像的文件路径列表。然后我有一张桌子，＆＃34; tmpDestFolders＆＃34;和现场＆＃34; FlatFile＆＃34;将图像复制到。我调用模块中的下面的函数来复制图像 - 但是，它只复制第一张图像，即使它们更多 - 这是为什么？我的循环是不正确的还是我需要把它放在类模块中？

Public Function CopyStyle()

Dim rst As ADODB.Recordset
Dim strSQL As String
Dim strEmail As String
Dim ToPath As String
Dim FromPath As String
Dim fso As Object

Set fso = VBA.CreateObject("Scripting.FileSystemObject")

FromPath = DLookup("FilePath", "qryMatchingStyle")
ToPath = DLookup("FlatFile", "tmpDestFolders")

Set rst = New ADODB.Recordset

DoCmd.SetWarnings False

strSQL = "[qryMatchingStyle]"  'source of recordset
rst.Open strSQL, CurrentProject.Connection, adOpenKeyset, adLockOptimistic

If Not rst.EOF Then
  Do While Not rst.EOF
  'copy file code here

  Call fso.CopyFile(FromPath, ToPath)

  rst.MoveNext
  Loop
End If

Set rst = Nothing

'Update flag to say style was copied
DoCmd.RunSQL "UPDATE qryMatchingStyle INNER JOIN tblLocalStyleCol ON qryMatchingStyle.Style = tblLocalStyleCol.Style SET tblLocalStyleCol.[Style Copied] = True", -1

'MsgBox "All matching style images copied"       

End Function

Answer 1

这是因为FromPath和ToPath被分配了一次;它们不是来自Recordset。试试这个：

Do While Not rst.EOF
   FromPath = rst.Fields("FilePath").Value
   ToPath = rst.Fields("FlatFile").Value
   Call fso.CopyFile(FromPath, ToPath)
   rst.MoveNext
Loop

P.S。不需要包含此循环的If Not rst.EOF语句，也不需要FromPath和ToPath的第一个分配。这些可以从您的代码中删除。

访问VBA复制图像仅复制第一张图像

1 个答案: