Find a string defined by user

[CHaigh90]

Hello,

I am currently writting a macro which will be used when sending our meeting minutes.

I want my macro to search for the word "ACTION" and then the name of the person whos action it is, copy and paste their action to a string which I plan on using further down the line.

My code looks like this at the moment, however it cannot get it to work. When i remove the text I have hilighted in red the code works, however this means that I am only searching for Actions and not making them specific to the user.

Please can you help with where I am going wrong?

Dim name1 As String

name1 = ActiveDocument.Shapes("Text Box 7").TextFrame.TextRange.Text

Selection.Find.ClearFormatting
With Selection.Find
.Text = "ACTION " & name1
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Do While Selection.Find.Execute
Selection.StartOf Unit:=wdParagraph
Selection.MoveEnd Unit:=wdParagraph
sBigString = sBigString + Selection.Text
Selection.MoveStart Unit:=wdParagraph
Loop

[gmayor]

What is it that immediately follows "ACTION " in the document that you are searching? The search string will not find the text if it is not exactly the same as "ACTION Name1" where Name1 is the value you are searching for.

name1 = Trim(ActiveDocument.Shapes("Text Box 7").TextFrame.TextRange.Text)

might be closer but I have this uneasy feeling that Name1 is elsewhere in the document.
Add

MsgBox name1

immediately after the above line and ensure it reports what you expect to find.
Better still, attach a copy of a document to the thread so we can see what it is you are attempting.

[CHaigh90]

Hi Gmayor, thank you for looking into this for me, the exact extract from my word document would be something like

"ACTION Chris Haigh To make a macro to simplify taking meeting minutes"

I tried your first suggestion and it didnt work.

I have attached a copy of my file, please do not laugh too much at my awful codeDouble send.docx

[gmayor]

There was no code in the document (which was DOCX format) and the Text Box was not Text Box 7, so it was never going to work.
I would recommend not using a text box, which is in the graphics layer of the document, and use instead a text content control. From its properties give it the title of "Minute Taker" and then run the following macro to grab the paragraph containing the name:

Sub ProcessDocument()
Dim oCC As ContentControl
Dim strName As String
Dim oRng As Range
Dim oFound As Range
Dim strFound As String
    For Each oCC In ActiveDocument.ContentControls
        If oCC.Title = "Minute Taker" Then
            strName = Trim(oCC.Range.Text)
            Exit For
        End If
    Next oCC
    Set oRng = ActiveDocument.Range
    With oRng.Find
        Do While .Execute(FindText:="ACTION " & strName)
            Set oFound = oRng.Paragraphs(1).Range
            oFound.End = oFound.End - 1
            strFound = oFound.Text
            Exit Do
        Loop
        'strFound is the paragraph
        MsgBox strFound
    End With
lbl_Exit:
    Set oCC = Nothing
    Set oRng = Nothing
    Exit Sub
End Sub

If the named individual in the document is the person entering the name in the form, then you could grab the username from the PC to fill the Content Control when the document is opened e.g.

Sub AutoOpen()
Dim oCC As ContentControl
Dim strName As String
strName = Environ$("Username")
For Each oCC In ActiveDocument.ContentControls
        If oCC.Title = "Minute Taker" Then
            oCC.Range.Text = strName
            Exit For
        End If
    Next oCC
lbl_Exit:
    Exit Sub
End Sub

[CHaigh90]

Double send.docmHi Gmayor

Thank you for your help, I have reattached my file as a macro enabled file.

I have run through my code and it does pick up the name from textbox 7.

Would you mind taking a look at where you belive the error lies before I go and remake my entire macro.

[gmayor]

The attachment doesn't include the code, which is almost certainly in your normal template. Either copy the code to the document or paste the code in a message (Use the # tool to mark the code as code).

[CHaigh90]

Apologies, im not very good at this am I

Sub sendeMail()
Dim olkApp As Object
Dim strSubject As String
Dim strTo As String
Dim strBody As String
Dim strBody2 As String
Dim strBody3 As String
Dim strBody4 As String
Dim strBody5 As String
Dim strBody6 As String
Dim strAtt As String
Dim Mail As String
Dim mail2 As String
Dim mail3 As String
Dim mail4 As String
Dim Mail5 As String
Dim mail6 As String
Dim str1 As String
Dim str2 As String
Dim str3 As String
Dim str4 As String
Dim str5 As String
Dim str6 As String
Dim test1 As DataObject
Set dFname = New DataObject
Dim name1 As String
Dim name2 As String
Dim name3 As String
Dim name4 As String
Dim name5 As String
Dim name6 As String
Dim TextToFind As String, TheContent As String
Dim rng As Word.Range
Dim host As String

strAtt = ActiveDocument.FullName
Mail = ActiveDocument.Shapes("Text Box 1").TextFrame.TextRange.Text ' setting the email addresses from what is input in the text box's
mail2 = ActiveDocument.Shapes("Text Box 2").TextFrame.TextRange.Text
mail3 = ActiveDocument.Shapes("Text Box 3").TextFrame.TextRange.Text
mail4 = ActiveDocument.Shapes("Text Box 4").TextFrame.TextRange.Text
Mail5 = ActiveDocument.Shapes("Text Box 5").TextFrame.TextRange.Text
mail6 = ActiveDocument.Shapes("Text Box 6").TextFrame.TextRange.Text
name1 = Trim(ActiveDocument.Shapes("Text Box 7").TextFrame.TextRange.Text)
name2 = ActiveDocument.Shapes("Text Box 8").TextFrame.TextRange.Text
name3 = ActiveDocument.Shapes("Text Box 9").TextFrame.TextRange.Text
name4 = ActiveDocument.Shapes("Text Box 10").TextFrame.TextRange.Text
name5 = ActiveDocument.Shapes("Text Box 11").TextFrame.TextRange.Text
name6 = ActiveDocument.Shapes("Text Box 12").TextFrame.TextRange.Text
host = ActiveDocument.Shapes("Text Box 13").TextFrame.TextRange.Text
    str1 = Mail
    str2 = mail2
    str3 = mail3
    str4 = mail4
    str5 = Mail5
    str6 = mail6
 
 
 
    Selection.Find.ClearFormatting
With Selection.Find
.Text = "ACTION " & name1
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Do While Selection.Find.Execute
Selection.StartOf Unit:=wdParagraph
Selection.MoveEnd Unit:=wdParagraph
sBigString = sBigString + Selection.Text
Selection.MoveStart Unit:=wdParagraph
Loop
'Documents.Add DocumentType:=wdNewBlankDocument
'Selection.InsertAfter (sBigString)
      
      
   
    strSubject = "Today's Meeting Minutes"
    strBody = "Dear " & name1 & "Please see attached File for the minutes of todays meeting." & vbNewLine & vbNewLine & "Please see below for a list of actions taken from the meeting:" & vbNewLine & vbNewLine & sBigString & vbNewLine & vbNewLine & vbNewLine & "Kind Regards" & vbNewLine & vbNewLine & host
    strBody2 = "Dear " & name2 & "Please see attached File for the minutes of todays meeting." & vbNewLine & vbNewLine & "Please see below for a list of actions taken from the meeting:" & vbNewLine & vbNewLine & sBigString & vbNewLine & vbNewLine & vbNewLine & "Kind Regards" & vbNewLine & vbNewLine & host
    strBody3 = "Dear " & name3 & "Please see attached File for the minutes of todays meeting." & vbNewLine & vbNewLine & "Please see below for a list of actions taken from the meeting:" & vbNewLine & vbNewLine & sBigString & vbNewLine & vbNewLine & vbNewLine & "Kind Regards" & vbNewLine & vbNewLine & host
    strBody4 = "Dear " & name4 & "Please see attached File for the minutes of todays meeting." & vbNewLine & vbNewLine & "Please see below for a list of actions taken from the meeting:" & vbNewLine & vbNewLine & sBigString & vbNewLine & vbNewLine & vbNewLine & "Kind Regards" & vbNewLine & vbNewLine & host
    strBody5 = "Dear " & name5 & "Please see attached File for the minutes of todays meeting." & vbNewLine & vbNewLine & "Please see below for a list of actions taken from the meeting:" & vbNewLine & vbNewLine & sBigString & vbNewLine & vbNewLine & vbNewLine & "Kind Regards" & vbNewLine & vbNewLine & host
    strBody6 = "Dear " & name6 & "Please see attached File for the minutes of todays meeting." & vbNewLine & vbNewLine & "Please see below for a list of actions taken from the meeting:" & vbNewLine & vbNewLine & sBigString & vbNewLine & vbNewLine & vbNewLine & "Kind Regards" & vbNewLine & vbNewLine & host
    
    If ActiveDocument.FullName = "" Then
        MsgBox "activedocument not saved, exiting"
        Exit Sub
    Else
        If ActiveDocument.Saved = False Then
            If MsgBox("Activedocument NOT saved, Proceed?", vbYesNo, "Error") <> vbYes Then Exit Sub
        End If
    End If
    
    On Error GoTo ErrorHandler
    Set olkApp = CreateObject("outlook.application")
    With olkApp.CreateItem(0)
        .To = str1
        .Subject = strSubject
        .Body = strBody
        .Attachments.Add strAtt
        .Send
    End With
    Set olkApp = Nothing
    Set olkApp = CreateObject("outlook.application")
    With olkApp.CreateItem(0)
        .To = str2
        .Subject = strSubject
        .Body = strBody2
        .Attachments.Add strAtt
        .Send
        On Error GoTo ErrorHandler
    End With
    Set olkApp = Nothing
    
    Set olkApp = CreateObject("outlook.application")
    With olkApp.CreateItem(0)
        .To = str3
        .Subject = strSubject
        .Body = strBody3
        .Attachments.Add strAtt
        .Send
    End With
    Set olkApp = Nothing
    
    Set olkApp = CreateObject("outlook.application")
    With olkApp.CreateItem(0)
        .To = str4
        .Subject = strSubject
        .Body = strBody4
        .Attachments.Add strAtt
        .Send
        On Error GoTo ErrorHandler
    End With
    Set olkApp = Nothing
    
    Set olkApp = CreateObject("outlook.application")
    With olkApp.CreateItem(0)
        .To = str5
        .Subject = strSubject
        .Body = strBody5
        .Attachments.Add strAtt
        .Send
        On Error GoTo ErrorHandler
    End With
    Set olkApp = Nothing
    
    Set olkApp = CreateObject("outlook.application")
    With olkApp.CreateItem(0)
        .To = str6
        .Subject = strSubject
        .Body = strBody6
        .Attachments.Add strAtt
        .Send
        On Error GoTo ErrorHandler
    End With
    Set olkApp = Nothing
    
ErrorHandler:
   

End Sub

[gmayor]

I don't wish to be disparaging, but this is wrong on so many levels.

First of all you only need one Outlook application, and if it is already running it is faster to use that one.

As I mentioned before text boxes are a pain, and completely unnecessary (unless the document is being created by some third party application, which I suspect is not the case). Use a table, as this looks the same and is much easier to work with. You can loop through the table and create a message for each row, and if there are more people involved, you can simply tab out of the last row to create a new row formatted like the previous row. (Remove my name from the table and the extra body text after testing)

I have modified the code to do what I believe you want. When you have tested it you can restore the .Send command (currently it displays the messages).

The document should be saved as a macro enabled template and new minutes should be created from it. This will run the AutoNew macro to insert the user's name in the content control and set the date. If you don't want that, then you can lose the AutoNew macro.

[CHaigh90]

Hi Graham,

Thank you very much for all of your help, it is very much appreciated.

Annoyingly our work system blocks your file but I will download it at home and send it to myself.

[gmayor]

It could be the format it objects to. Maybe you can download it from https://dl.dropboxusercontent.com/u/...ble%20send.zip