访问 VBA 复制图像仅复制第一个图像答案

【问题标题】：Access VBA Copy images is only copying first image访问 VBA 复制图像仅复制第一个图像
【发布时间】：2017-01-12 09:13:36
【问题描述】：

我正在使用 Access 2013 并且有一个查询“qryMatchingStyle”和字段“FilePath”，其中包含要从中复制图像的文件路径列表。然后我有一个表格，“tmpDestFolders”和“FlatFile”字段来复制图像。我调用模块中的以下函数来复制图像-但是，即使它们更多，它也只会复制第一个图像-这是为什么？我的循环不正确还是需要将其放入类模块中？

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

【问题讨论】：

标签： loops ms-access vba

【解决方案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

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

【讨论】：

@Micahel 很高兴知道它有帮助。