VBA代码循环记录集和复制字段

Question

我有一个数据库，人们可以使用以下代码将数据从表单复制到剪贴板：

Private Sub cmdCopy_Click()
Dim strToCopy As String
    strToCopy = Forename & " " & Surname & vbCrLf & vbCrLf & "Intended Course: " & [Intended course] & vbCrLf & vbCrLf & "Subject: " & [Subject] & vbCrLf & vbCrLf & "Predicted Grade: " & [Predicted Grade] & vbCrLf & vbCrLf & "Academic skills: " & [Academic skills] & vbCrLf & vbCrLf & "Suitablity for intended course: " & [Suitability] & vbCrLf & vbCrLf & " Work ethic: " & [Work Ethic] & " " & vbCrLf & vbCrLf & "Prior attainment: " & " " & [Prior attainment] & " " & vbCrLf
    'open a dummy form and write the string to it
    DoCmd.OpenForm "frmDummy"
    Screen.ActiveForm.txtCopy = strToCopy
    Screen.ActiveForm.txtCopy.SetFocus
    'copy from form to clipboard
    DoCmd.RunCommand acCmdCopy
    'close the form
    DoCmd.Close
End Sub

然而，用户必须按“下一条记录”并重复该过程几次。我正在循环并从表单中复制数据，直到达到数据集的末尾。我试过这个：

 Private Sub cmdCopy_Click()
Dim strToCopy As String
While Me.CurrentRecord < Me.Recordset.RecordCount-1
    strToCopy = Forename & " " & Surname & vbCrLf & vbCrLf & "Intended Course: " & [Intended course] & vbCrLf & vbCrLf & "Subject: " & [Subject] & vbCrLf & vbCrLf & "Predicted Grade: " & [Predicted Grade] & vbCrLf & vbCrLf & "Academic skills: " & [Academic skills] & vbCrLf & vbCrLf & "Suitablity for intended course: " & [Suitability] & vbCrLf & vbCrLf & " Work ethic: " & [Work Ethic] & " " & vbCrLf & vbCrLf & "Prior attainment: " & " " & [Prior attainment] & " " & vbCrLf
    DoCmd.OpenForm "frmDummy"
    Screen.ActiveForm.txtCopy = Screen.ActiveForm.txtCopy + strToCopy
    Screen.ActiveForm.txtCopy.SetFocus
    DoCmd.GoToRecord Record:=acNext
Wend
    DoCmd.RunCommand acCmdCopy
    DoCmd.Close
End Sub

但是，这会抛出错误，说复制命令在此处不可用。我怀疑（但不确定）.SetFocus命令必须紧接在acCmdCopy命令之前，这就是为什么它不起作用...我是否正确，如果是的话，我有什么想法可以解决这个问题？< / p>

非常感谢！

编辑：根据下面的反馈，到目前为止，我有这个代码，但它没有复制到剪贴板......

Dim strToCopy As String
While Me.CurrentRecord < Me.Recordset.RecordCount - 1
    strToCopy = Forename & " " & Surname & vbCrLf & vbCrLf & "Intended Course: " & [Intended course] & vbCrLf & vbCrLf & "Subject: " & [Subject] & vbCrLf & vbCrLf & "Predicted Grade: " & [Predicted Grade] & vbCrLf & vbCrLf & "Academic skills: " & [Academic skills] & vbCrLf & vbCrLf & "Suitablity for intended course: " & [Suitability] & vbCrLf & vbCrLf & " Work ethic: " & [Work Ethic] & " " & vbCrLf & vbCrLf & "Prior attainment: " & " " & [Prior attainment] & " " & vbCrLf
Wend

With New DataObject
        .SetText s
        .PutInClipboard
End With

由于.SetText无法获取命名参数，因此更改了虚拟表单。现在收到错误消息“需要对象”

Dim strToCopy As String
While Me.CurrentRecord < Me.Recordset.RecordCount - 1
    strToCopy = Forename & " " & Surname & vbCrLf & vbCrLf & "Intended Course: " & [Intended course] & vbCrLf & vbCrLf & "Subject: " & [Subject] & vbCrLf & vbCrLf & "Predicted Grade: " & [Predicted Grade] & vbCrLf & vbCrLf & "Academic skills: " & [Academic skills] & vbCrLf & vbCrLf & "Suitablity for intended course: " & [Suitability] & vbCrLf & vbCrLf & " Work ethic: " & [Work Ethic] & " " & vbCrLf & vbCrLf & "Prior attainment: " & " " & [Prior attainment] & " " & vbCrLf
    DoCmd.OpenForm "frmDummy"
    Screen.ActiveForm.txtCopy = Screen.ActiveForm.txtCopy + strToCopy
Wend

With New DataObject
        .SetText frmDummy.txtCopy
        .PutInClipboard
End With

Answer 1

试试这个......

Private Sub cmdCopy_Click()
    Dim strToCopy As String

    While Me.CurrentRecord < Me.Recordset.RecordCount - 1
        strToCopy = strToCopy & Forename & " " & Surname & vbCrLf & vbCrLf & "Intended Course: " & [Intended course] & vbCrLf & vbCrLf & "Subject: " & [Subject] & vbCrLf & vbCrLf & "Predicted Grade: " & [Predicted Grade] & vbCrLf & vbCrLf & "Academic skills: " & [Academic skills] & vbCrLf & vbCrLf & "Suitablity for intended course: " & [Suitability] & vbCrLf & vbCrLf & " Work ethic: " & [Work Ethic] & " " & vbCrLf & vbCrLf & "Prior attainment: " & " " & [Prior attainment] & " " & vbCrLf
    Wend

    Msgbox(strToCopy)

    With New DataObject
        .SetText strToCopy
        .PutInClipboard
    End With

    'the text should now be in the clipboard!
End Sub

使用不使用表单创建字符串的宏可能有更好的方法（例如，单击一个宏按钮，它最终都在剪贴板中 - 无需任何表格）！

例如......

Sub Test()

    Dim s As String

    For i = 1 To 5

        s = s & Cells(i, 1).Value

    Next i

    With New DataObject
        .SetText s
        .PutInClipboard
    End With

    Range("B1").PasteSpecial

End Sub

在此工作表上使用时会在单元格B1中产生结果...这可以适应循环记录，而不是单元格......