A
acs68
Hi all,
I have some code below that grabs various records and merges into one text
field. How can I at the same time as running this code , copy the text to
clipboard for pasting into word etc ?
Here's the Code:
If DCount("*", "tblConditions_Merged", "AppNo = '" & Me.txtAppNo & "'") > 0
Then
MsgBox "Merged Conditions for this record already exist", 48, "Record
Exists"
Cancel = True
GoTo Exit_btnMergeCond_Click
End If
Dim db As Database
Dim TextRS As Recordset
Dim MergeRS As Recordset
Dim DeleteQD As QueryDef
Dim MergedTextStr As String
Dim NewLineMarkerStr As String
Dim Record_ID_Text As String
Set db = CurrentDb()
'Open the tables
Set TextRS = db.OpenRecordset("SELECT tblConditions_Build.Rec_Id,
tblConditions_Build.AppNo, tblConditions_Build.Condition_Id,
tblConditions_Build.Print_Yes_or_No, tblConditions.Condition_Text FROM
tblConditions_Build LEFT JOIN tblConditions ON
tblConditions_Build.Condition_Id = tblConditions.ID WHERE
(((tblConditions_Build.AppNo)=('" & [Forms]![frmmain]![txtAppNo] & "')) AND
((tblConditions_Build.Print_Yes_or_No)=Yes));")
Set MergeRS = db.OpenRecordset("SELECT tblConditions_Merged.* FROM
tblConditions_Merged;")
'MsgBox TextRS
'Define number of CR/LF (2 of each will give 1 blank line)
NewLineMarkerStr = Chr(13) & Chr(10) & Chr(13) & Chr(10)
MergedTextStr = ""
TextRS.MoveFirst
'Build merged text by looping through individual text fields and adding a
CR/LF
Do While Not TextRS.EOF
MergedTextStr = MergedTextStr & TextRS.Fields("Condition_Text").Value &
NewLineMarkerStr
TextRS.MoveNext
Loop
MergeRS.AddNew
MergeRS.Fields("Condition_Text_Merged").Value = MergedTextStr
MergeRS.Fields("AppNo").Value = txtAppNo
MergeRS.Update
TextRS.Close
MergeRS.Close
MergedTextStr = ""
Forms!frmmain.Requery
MsgBox "Successfully Merged Conditions", 64, "Merge Conditions"
Forms!frmmain!frmMerged.Requery
Exit_btnMergeCond_Click:
End Sub
I have some code below that grabs various records and merges into one text
field. How can I at the same time as running this code , copy the text to
clipboard for pasting into word etc ?
Here's the Code:
If DCount("*", "tblConditions_Merged", "AppNo = '" & Me.txtAppNo & "'") > 0
Then
MsgBox "Merged Conditions for this record already exist", 48, "Record
Exists"
Cancel = True
GoTo Exit_btnMergeCond_Click
End If
Dim db As Database
Dim TextRS As Recordset
Dim MergeRS As Recordset
Dim DeleteQD As QueryDef
Dim MergedTextStr As String
Dim NewLineMarkerStr As String
Dim Record_ID_Text As String
Set db = CurrentDb()
'Open the tables
Set TextRS = db.OpenRecordset("SELECT tblConditions_Build.Rec_Id,
tblConditions_Build.AppNo, tblConditions_Build.Condition_Id,
tblConditions_Build.Print_Yes_or_No, tblConditions.Condition_Text FROM
tblConditions_Build LEFT JOIN tblConditions ON
tblConditions_Build.Condition_Id = tblConditions.ID WHERE
(((tblConditions_Build.AppNo)=('" & [Forms]![frmmain]![txtAppNo] & "')) AND
((tblConditions_Build.Print_Yes_or_No)=Yes));")
Set MergeRS = db.OpenRecordset("SELECT tblConditions_Merged.* FROM
tblConditions_Merged;")
'MsgBox TextRS
'Define number of CR/LF (2 of each will give 1 blank line)
NewLineMarkerStr = Chr(13) & Chr(10) & Chr(13) & Chr(10)
MergedTextStr = ""
TextRS.MoveFirst
'Build merged text by looping through individual text fields and adding a
CR/LF
Do While Not TextRS.EOF
MergedTextStr = MergedTextStr & TextRS.Fields("Condition_Text").Value &
NewLineMarkerStr
TextRS.MoveNext
Loop
MergeRS.AddNew
MergeRS.Fields("Condition_Text_Merged").Value = MergedTextStr
MergeRS.Fields("AppNo").Value = txtAppNo
MergeRS.Update
TextRS.Close
MergeRS.Close
MergedTextStr = ""
Forms!frmmain.Requery
MsgBox "Successfully Merged Conditions", 64, "Merge Conditions"
Forms!frmmain!frmMerged.Requery
Exit_btnMergeCond_Click:
End Sub