#1
|
|||
|
|||
Copy value from RTF content control and paste it into filename
Hi there. I'd appreciate some help please, if possible. I've created a Word macro that's activated by a button click (within the Word document). The end user clicks on the button, it saves a copy of the file to their desktop with a specific naming convention, opens an email in Outlook (desktop app), attaches the copy of the Word doc, and fills out the email with all of the applicable info. Those pieces all work fine.
What I'm struggling with is a new "enhancement" request to the process. I need to update the macro to also copy data from a specific field in the Word document (a rich text content control) and then paste that data into the file name when the macro runs the save as function. This pasted data is the ID # of the submission, which the user is required to input into the aforementioned content control (Content Control Title = "SubmissionIDNo" and Tag also = "SubmissionIDNo"). I've never done this particular function in Word before. I've tried more VBA combinations than I care to admit so far and can get close, but not quite there. At this point, my brain is fried and I think I'm just making it worse. I've looked all over various forums and haven't found anything that explicitly addresses this use case, but I'm not a VBA expert by any means, so it could just be my misunderstanding of an already-solved problem. Anyway, below is my code. Again, any help would be greatly appreciated. Many thanks in advance. Code:
Private Sub CommandButton1_Click() Call FindCCbyTitleAndTag Dim StrPath As String DTAddress = CreateObject("WScript.Shell").SpecialFolders("Desktop") & Application.PathSeparator ActiveDocument.SaveAs DTAddress & "CCB Proposal Submission ID # " & SubmissionIDNo, FileFormat:=wdFormatXMLDocument Dim OL As Object Dim EmailItem As Object Dim Doc As Document Application.ScreenUpdating = False Set OL = CreateObject("Outlook.Application") Set EmailItem = OL.CreateItem(olMailItem) Set Doc = ActiveDocument Doc.Save MsgBox "Your CCB proposal document has been saved to your desktop as 'CCB Proposal Submission ID # (plus the applicable ID #)'. Click 'OK' to open your submission email draft." With EmailItem .Subject = Doc .Subject = Replace(Doc, ".docx", "") .Body = "Greetings," & vbCrLf & vbCrLf & _ "Attached please find a CCB proposal submission." & vbCrLf & vbCrLf & _ "Please let me know if you have any questions." & vbCrLf & vbCrLf & _ "Thank you." .To = "NAME_REDACTED" .CC = "NAME_REDACTED" .Attachments.Add Doc.FullName .Display End With Application.ScreenUpdating = True Set Doc = Nothing Set OL = Nothing End Sub Private Function FindCCbyTitleAndTag() Dim Title As ContentControl Dim Tag As ContentControl Dim CC As ContentControl For Each CC In ActiveDocument.ContentControls If CC.Title = SubmissionIDNo And CC.Tag = SubmissionIDNo Then Call GetClip End If Next CC End Function Private Function GetClip() As String Dim MyData As New DataObject Dim strClip As String Set MyData = New DataObject MyData.GetFromClipboard strClip = MyData.GetText GetClip = strClip End Function |
#2
|
|||
|
|||
Anybody know what I'm doing wrong in my code?
|
#3
|
|||
|
|||
I figured it out on my own. Thanks for the "help".
|
#4
|
||||
|
||||
Frankly I wouldn't do it quite like that. First I would use the function referred to in the comment at the start of the code below to open Outlook correctly. You can then use the Word Editor to edit the message body and retain the default signature.
I have made some changes to your code to get the ID number from the CC to eliminate the pasting. Code:
Option Explicit Private Sub CommandButton1_Click() 'Graham Mayor - https://www.gmayor.com - Last updated - 14 Jan 2021 'Requires the code from http://www.rondebruin.nl/win/s1/outlook/openclose.htm 'to either retrieve an open instance of Outlook or open Outlook if it is closed. Dim strPath As String, sID As String Dim OL As Object Dim olInsp As Object Dim oDoc As Document, wdDoc As Document Dim oRng As Range Dim EmailItem As Object sID = GetCC If sID = "" Then Exit Sub strPath = Environ("UserProfile") & "\Desktop\" Set oDoc = ActiveDocument oDoc.SaveAs2 FileName:=strPath & "CCB Proposal Submission ID # " & sID & ".docx", FileFormat:=wdFormatXMLDocument Application.ScreenUpdating = False Set OL = OutlookApp Set EmailItem = OL.CreateItem(0) MsgBox "Your CCB proposal document has been saved to your desktop as 'CCB Proposal Submission ID # " & sID & "'." & vbCr & vbCr & _ "Click 'OK' to open your submission email draft." With EmailItem .Subject = Left(oDoc.Name, InStrRev(oDoc.Name, ".") - 1) .To = "NAME_REDACTED" .CC = "NAME_REDACTED" .Attachments.Add oDoc.FullName .BodyFormat = 2 'olFormatHTML Set olInsp = .GetInspector Set wdDoc = olInsp.WordEditor Set oRng = wdDoc.Range oRng.Collapse 1 oRng.Text = "Greetings," & vbCrLf & vbCrLf & _ "Attached please find a CCB proposal submission." & vbCrLf & vbCrLf & _ "Please let me know if you have any questions." & vbCrLf & vbCrLf & _ "Thank you." .Display End With Application.ScreenUpdating = True Set oDoc = Nothing Set OL = Nothing Set wdDoc = Nothing Set oRng = Nothing Set olInsp = Nothing End Sub Private Function GetCC() As String Dim oCC As ContentControl For Each oCC In ActiveDocument.ContentControls If oCC.Title = "SubmissionIDNo" And oCC.Tag = "SubmissionIDNo" Then If oCC.ShowingPlaceholderText = True Then MsgBox "Enter the SubmissionIDNo" oCC.Range.Select GoTo lbl_Exit Else GetCC = oCC.Range.Text End If Exit For End If Next oCC lbl_Exit: Set oCC = Nothing Exit Function End Function
__________________
Graham Mayor - MS MVP (Word) (2002-2019) Visit my web site for more programming tips and ready made processes www.gmayor.com |
Tags |
content control, vba code, word 16. |
|
Similar Threads | ||||
Thread | Thread Starter | Forum | Replies | Last Post |
Copy Text only of a Content Control | JuliaZ | Word | 6 | 03-28-2022 07:37 AM |
Auto populate text box based on drop-down content control and repeat the process via copy paste | helenndp | Word VBA | 2 | 09-27-2018 11:04 AM |
Content Control Copy - Copies Data and CC itself | shammi_raj | Word | 3 | 03-30-2016 07:01 PM |
Is there VBA to paste text into content control? | kintap | Word VBA | 2 | 07-02-2014 07:42 AM |
Copy content control entries to next table next page | Mel_Herndon | Word VBA | 2 | 05-22-2014 05:07 PM |