Word Macro

[Puventus]

Hello, I have never even come accross word macros before so would
really appreciate some help please??

I have a Word Document filled with payment information. I want to
extract all the information marked with an "X" using the header
information as markers, assuming this is the best way? The "X"
information can be varying in length of characters in any of the fields.

I guess all I need is a macro to use on one set of information that
can they be applied to all the sets within the doc.

here is an example.....


Payment XXXX Accepted Beneficiary Details Number XXXX
Country XXXXXXXXX
Name XXXXX XXXXXXXX XXX XXXXX
XX XXXXX XX
XXXXX XX XXXXXX XXX XXXXX XXXXX
Payment Instructions ADVISE & CREDIT
Payment Details XXXXXXXX XX XXXX XXX XXXXXXXXXXX
Account Number XXXXXXXXX
Bank SWIFT ID XXXXXXXX
Bank XXXX XXXX XXX XXXXXX
XXX XXXXX XXXXXX XXX XXXX XX XXXXX XXXXXX XXXXXX

[Puventus]

Great success!!

I have managed to create the following, albeit a bit crude but does the job.....

Next problem is, each time the macro fires I want it to capture the results and if possible build a csv containing all the results from each firing.... is that possible???

Sub Copy()
'
' Copy Macro
' Macro recorded 08/10/2009 by XXXXXXXXXXX'
 
Dim searchstrings(10) As String
 
Dim position1 As Integer
Dim position2 As Integer
''Dim position3 As Integer
 
Dim enddoc As Boolean
 
searchstrings(1) = "Payment"
 
searchstrings(2) = "Beneficiary Details Number"
 
searchstrings(3) = "Country"
 
searchstrings(4) = "Name"
 
searchstrings(5) = "Payment Instructions"
 
searchstrings(6) = "Payment Details"
 
searchstrings(7) = "Account Number"
 
searchstrings(8) = "Bank"
 
searchstrings(9) = "Bank"
 
searchstrings(10) = "Payment"
 
Selection.Move wdCharacter, -Selection.Start
 
Dim offset As Integer
 
enddoc = False
 
While Not enddoc
    i = 1
    offset = 0
    finishstring = " "
    While i < 10
        Selection.Find.ClearFormatting
        With Selection.Find
            .Text = searchstrings(i)
            .Replacement.Text = ""
            .Forward = True
            .Wrap = wdFindContinue
            .Format = False
            .MatchCase = False
            .MatchWholeWord = False
            .MatchWildcards = False
            .MatchSoundsLike = False
            .MatchAllWordForms = False
        End With
        Selection.Find.Execute
        position1 = Selection.End + 1
        If i = 8 Then
            Selection.MoveStart wdCharacter, 5
            Selection.MoveEnd wdCharacter, 9
            
            If UCase(Trim(Selection.Text)) <> "SWIFT ID" Then
                finishstring = finishstring & ","
                offset = 1
                Selection.MoveStart wdCharacter, Len(Selection.Text)
                position1 = position1
                With Selection.Find
                    .Text = searchstrings(i + 2)
                    .Replacement.Text = ""
                    .Forward = True
                    .Wrap = wdFindContinue
                    .Format = False
                    .MatchCase = False
                    .MatchWholeWord = False
                    .MatchWildcards = False
                    .MatchSoundsLike = False
                    .MatchAllWordForms = False
                End With
                Selection.Find.Execute
                enddoc = Selection.Start = 0
                position2 = Selection.End
                Selection.MoveEnd wdCharacter, -Len(searchstrings(i + 2))
                Selection.MoveStart wdCharacter, -(position2 - position1 - Len(searchstrings(i + 2)))
                j = 1
                While j <= Len(Selection.Text)
                    If Mid(Selection.Text, j, 1) = vbCrLf Then
                        Selection.MoveStart wdCharacter, 1
                    End If
                    j = j + 1
                Wend
                finishstring = finishstring & Replace(Trim(Selection.Text), vbCrLf, " ")
            Else
                Selection.MoveStart wdCharacter, Len(Selection.Text)
                position1 = position1 + 9
                With Selection.Find
                    .Text = searchstrings(i + 1)
                    .Replacement.Text = ""
                    .Forward = True
                    .Wrap = wdFindContinue
                    .Format = False
                    .MatchCase = False
                    .MatchWholeWord = False
                    .MatchWildcards = False
                    .MatchSoundsLike = False
                    .MatchAllWordForms = False
                End With
                Selection.Find.Execute
                enddoc = Selection.Start = 0
                position2 = Selection.End
                Selection.MoveEnd wdCharacter, -Len(searchstrings(i + 1))
                Selection.MoveStart wdCharacter, -(position2 - position1 - Len(searchstrings(i + 1)))
                j = 1
                While j <= Len(Selection.Text)
                    If Mid(Selection.Text, j, 1) = vbCrLf Then
                        Selection.MoveStart wdCharacter, 1
                    End If
                    j = j + 1
                Wend
                finishstring = finishstring & Replace(Trim(Selection.Text), vbCrLf, " ")
            End If
        Else
             Selection.MoveStart wdCharacter, Len(Selection.Text)
                With Selection.Find
                    .Text = searchstrings(i + 1)
                    .Replacement.Text = ""
                    .Forward = True
                    .Wrap = wdFindContinue
                    .Format = False
                    .MatchCase = False
                    .MatchWholeWord = False
                    .MatchWildcards = False
                    .MatchSoundsLike = False
                    .MatchAllWordForms = False
                End With
                Selection.Find.Execute
                enddoc = Selection.Start = 0
                position2 = Selection.End
                Selection.MoveEnd wdCharacter, -Len(searchstrings(i + 1))
                Selection.MoveStart wdCharacter, -(position2 - position1 - Len(searchstrings(i + 1)))
                j = 1
                While j <= Len(Selection.Text)
                    If Mid(Selection.Text, j, 1) = vbCrLf Then
                        Selection.MoveStart wdCharacter, 1
                    End If
                    j = j + 1
                Wend
                If i = 1 Then
                    finishstring = finishstring & Replace(Replace(Trim(Selection.Text), "Accepted", ""), vbCrLf, " ")
                Else
                    finishstring = finishstring & Replace(Trim(Selection.Text), vbCrLf, " ")
                End If
        End If
        If i + offset < 9 Then finishstring = finishstring & ","
        i = i + 1 + offset
    Wend
    MsgBox (Replace(Replace(finishstring, vbCr, " "), vbLf, " "))
Wend
 
End Sub

[Siddharth Rout]

No this is not what I suggested...

Did you go thru my last post...

[Puventus]

sorry, but it works!

any idea how I can extract it's results and store them somewhere else? either another word or excel file?

[westconn1]

possibly the simplest is to saveAs each time to some generated filename, using one of the variables or datetime value, so each filename will be unique

[Puventus]

cheers West, was hoping to build a single flat file from all the results of the macro though, any recommendations there?

[westconn1]

you can append to a text file if that is what you want to do

[RobDog888]

Usually its best to creat one thread for a single topic. It helps when others are searching etc.

[Puventus]

sorry, didn't want to clutter up your boards.

will look into it.

[RobDog888]

No please post up all your questions but for the ones that are spearate topics then please create separate threads