Microsoft Office Forums

Go Back   Microsoft Office Forums > >

 
 
Thread Tools Display Modes
Prev Previous Post   Next Post Next
  #9  
Old 08-22-2023, 07:42 AM
Onjai Onjai is offline VBA to cut colored text from one document and paste to another Windows 10 VBA to cut colored text from one document and paste to another Office 2016
Novice
VBA to cut colored text from one document and paste to another
 
Join Date: Aug 2023
Posts: 6
Onjai is on a distinguished road
Default

Posting working code.


Code:
Sub FindGreenText()
       'speed up procedure
Application.ScreenUpdating = False
Dim sel As Range
Dim oResponse As Document
Dim oDoc As Document
Dim strDocName As String, strPath As String, strFile As String, strFolder As String
    'point to location of files
strFolder = "<folder with .docx files>"
strFile = Dir(strFolder & "\*.docx", vbNormal)
    'process each .docx file in folder
While strFile <> ""
    Set oDoc = Documents.Open(FileName:=strFolder & "\" & strFile, AddToRecentFiles:=False, Visible:=True)
    oDoc.Activate
    'name the .docx file with a new name for responses
    strDocName = Left(oDoc.Name, InStrRev(oDoc.Name, Chr(46)) - 1)
    strDocName = strDocName & "_response.docx"
    'sets the path to save new .docx file based on location of original .docx file(oDoc)
    strPath = oDoc.Path & Chr(92)
    
    Set sel = ActiveDocument.Range
    Set oResponse = Documents.Add
        With sel.Find
            .ClearFormatting
            .Replacement.ClearFormatting
            .Text = ""
            .MatchWildcards = False
            .Forward = True
            .Wrap = wdFindStop
            'finds green colored text
            .Font.Color = 5287936
            .Execute
            Do Until Not .Found
                If sel.Font.Color = 5287936 Then
                    sel.Cut
                    'pastes green text to new .docx
                    With oResponse
                        Selection.Range.Paste
                        Selection.MoveStart unit:=wdParagraph
                        Selection.TypeParagraph
                    End With
                End If
                .Execute
            Loop
        End With
    oDoc.SaveAs2
    oResponse.SaveAs2 strPath & strDocName
    oDoc.Close
    oResponse.Close
    strFile = Dir()
Wend
Application.ScreenUpdating = True
MsgBox "Lucy, I'm home!"
End Sub
Reply With Quote
 



Similar Threads
Thread Thread Starter Forum Replies Last Post
VBA to cut colored text from one document and paste to another Copy selected text from one document and paste to new document in same position on the page gasparik Word VBA 1 05-11-2020 05:41 AM
VBA to cut colored text from one document and paste to another Why do pages 10-24 disappear when I type in more text on page 2 or paste new text into the document? RET Word 1 05-02-2016 07:28 PM
VBA to cut colored text from one document and paste to another colored background to text userman Word 2 09-26-2012 01:52 AM
not showing colored text from external emails MasterGator Outlook 0 01-31-2012 02:20 PM
Making text boxes with colored bar at the top daviddoria PowerPoint 0 08-30-2009 03:19 PM

Other Forums: Access Forums

All times are GMT -7. The time now is 04:49 AM.


Powered by vBulletin® Version 3.8.11
Copyright ©2000 - 2025, vBulletin Solutions Inc.
Search Engine Optimisation provided by DragonByte SEO (Lite) - vBulletin Mods & Addons Copyright © 2025 DragonByte Technologies Ltd.
MSOfficeForums.com is not affiliated with Microsoft