Sub AutoOpen()  'Starts the macro when the document is opened.
Call SSP2SHOUT

End Sub

Sub SSP2SHOUT()
' 10/17/2007
' SSP2SHOUT Macro
' Converts all SongShow Plus song files (.sbsong) in a specified folder to ShoutSinger Format text files
' Title, Author, Copyright, CCLI and Key signature fields are derived from the
' original SongShow Plus file.
' No distinction made between verse/chorus/ending/bridge etc - all stanzas are called
' as sequential verses in the Playorder.
'
' Disclaimer - this is unsupported freeware, the user agrees to indemnify and hold harmless the author(s) of this program against any claim, loss or damages.
'
' To God be the Glory!
'
' R. Noar
' Thanks to Mr. Jamie Thaine for adding the code to process all files in a folder
'


'   Copyright Message
    Dim Msg, Style, Title, Response, MyString
    Msg = "By Clicking 'Yes', I agree to accept sole liability for the use of this program, agree to abide by all copyright laws, and agree to indemnify and hold harmless the author(s) of this program against any claim, loss or damages."
    Style = vbYesNo    ' Define buttons.
    Title = "Disclaimer - SSP2SHOUT Version Date 10/21/2007 "
    Response = MsgBox(Msg, Style, Title)
    If Response = vbNo Then GoTo ExitSub

    Dim FolderPath As String
    FolderPath = InputBox("Please input the Folder Path of your sbsong folder:")  'Get the folder path
    If FolderPath = "" Then
    MsgBox "No Folder Path was given - exiting the program"
    GoTo ExitSub
    End If

    
'Process all files in the specified folder
Set fs = Application.FileSearch
With fs
    .LookIn = FolderPath
    .FileName = "*.sbsong"
    If .Execute(SortBy:=msoSortByFileName, _
    SortOrder:=msoSortOrderAscending) > 0 Then
        MsgBox "There were " & .FoundFiles.Count & " file(s) found."
'
'   Turn screen updating off - stops the annoying screen flashing while the macro is running
    Application.ScreenUpdating = False
'
        For i = 1 To .FoundFiles.Count
           SSP2SHOUT_File (.FoundFiles(i))
        Next i
    Else
'   Turn screen updating back on
    Application.ScreenUpdating = True
        MsgBox "There were no files found."
        GoTo ExitSub
    End If
End With
'
AllDone:
'   Turn screen updating back on
    Application.ScreenUpdating = True
    MsgBox ("ALL DONE!")
'
ExitSub:
End Sub
 
Sub SSP2SHOUT_File(cFileName)

    Documents.Open(cFileName).Activate 'Open a file
'   Create a working copy
'   Save the file as a text file, appending "ShoutSinger"
    appendname = "_ShoutSinger.txt"
    TitleDocName = ActiveDocument
    MyDocName = ActiveDocument.FullName
    pos = InStr(MyDocName, ".")
    If pos > 0 Then
        MyDocName = Left(MyDocName, pos - 1)
        MyDocName = MyDocName & appendname
        ActiveDocument.SaveAs FileName:=MyDocName, FileFormat:=wdFormatText
    End If
    
'   Use filename for song ID field later
    pos = InStr(TitleDocName, ".")
    If pos > 0 Then
        TitleDocName = Left(TitleDocName, pos - 1)
    End If

'   Replace ASCII "x00" with ASCII "x1E" (Decimal 30) since wildcard (eg "?") searches do not recognize ASCII x00 .
'   Find & replace done by searching for unicode 0000, since "find" will not find ^00 .
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "^u0000"
        .Replacement.Text = "^030"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll

'   Delete ASCII "x24" or "$"
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "^036"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll

'   Find Title
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "^001^030^030^030?{6}"
        .Replacement.Text = "Title: "
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = True
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceOne

'   Go To Top
    Selection.HomeKey Unit:=wdStory

'   Find Author
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "^002^030^030^030?{6}"
        .Replacement.Text = "^pAuthor: "
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = True
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceOne

'   Go To Top
    Selection.HomeKey Unit:=wdStory

'   Find Copyright
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "^003^030^030^030?{6}"
        .Replacement.Text = "^pCopyright: "
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = True
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceOne

'   Go To Top
    Selection.HomeKey Unit:=wdStory

'   Find CCLI
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "^005^030^030^030?{6}"
        .Replacement.Text = "^pCCLI: "
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = True
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceOne

'   Go To Top
    Selection.HomeKey Unit:=wdStory

'   Find spot for SongID tag
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "^012^030^030^030"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute
    
'   Put in Song ID Tag
    Selection.MoveLeft Unit:=wdCharacter, Count:=1
    Selection.TypeText Text:=Chr(11) & "Song ID: " & Left(TitleDocName, 8) & Right(TitleDocName, 8)
'    Selection.TypeText Text:=Chr(11)
    
'   Clean up Song ID Tag
'   Select the Song ID
    Selection.HomeKey Unit:=wdLine
    Selection.MoveRight Unit:=wdCharacter, Count:=9
    Selection.EndKey Unit:=wdLine, Extend:=wdExtend
    Selection.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtend
'   Remove spaces & other unwanted stuff from Song ID field
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
'   Note - anything that is not a number or alphabet char is removed
        .Text = "[!a-z,A-Z,0-9]"
        .Replacement.Text = ""
        .Forward = True
' !!! Note - Use wdFindStop so that replacements are only done in selected area
        .Wrap = wdFindStop
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = True
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
'   Remove any commas from Song ID field
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = ","
        .Replacement.Text = ""
        .Forward = True
' !!! Note - Use wdFindStop so that replacements are only done in selected area
        .Wrap = wdFindStop
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    
'   Insert line break
    Selection.EndKey Unit:=wdLine, Extend:=wdMove
    Selection.TypeText Text:=Chr(11)

'   Go To Top
    Selection.HomeKey Unit:=wdStory

'   Find Key/Notes
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "^011^030^030^030?{6}"
        .Replacement.Text = "^pNotes: "
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = True
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceOne

'   Go To Top
    Selection.HomeKey Unit:=wdStory

'   Chorus to Verse ???
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "^020^030^030^030"
        .Replacement.Text = "^012^030^030^030"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll

'   Find & count verses, add "Verse:" tags
    Dim VerseCnt
    VerseCnt = 0    ' Initialize variable.
ChkVerse:
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "^012^030^030^030?{8}"
        .Replacement.Text = "^p^pVerse: ^p"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = True
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    If Selection.Find.Execute(Replace:=wdReplaceOne) Then
    VerseCnt = VerseCnt + 1
    Selection.EndKey Unit:=wdLine, Extend:=wdMove
    GoTo ChkVerse
    Else
    End If


'   Remove extraneous text at end of song
    Selection.Find.ClearFormatting
    With Selection.Find
        .Text = "^029"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    If Selection.Find.Execute Then
    Selection.EndKey Unit:=wdStory, Extend:=wdExtend
    Selection.Delete Unit:=wdCharacter, Count:=1
    Else
    End If
    
'   Go To Top
    Selection.HomeKey Unit:=wdStory
    
'   Remove non-printable ASCII chars
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "[^001-^009]"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = True
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll

'   Go To Top
    Selection.HomeKey Unit:=wdStory

'   Remove non-printable ASCII chars
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "[^028-^031]"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = True
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll

'   Go To Top
    Selection.HomeKey Unit:=wdStory

'   Remove non-printable ASCII chars
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "[^128-^254]"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = True
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll

'   GoTo Top
    Selection.HomeKey Unit:=wdStory

'   Replace ^p with ^l
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "^p"
        .Replacement.Text = "^l"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll

'   GoTo Top
    Selection.HomeKey Unit:=wdStory

'   Find spot for Playorder tag
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "^l^l"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute
    
'   Put in Playorder Tag
    Selection.MoveRight Unit:=wdCharacter, Count:=1
    Selection.MoveLeft Unit:=wdCharacter, Count:=1
    Selection.TypeText Text:="Playorder: "
    Selection.TypeParagraph
    
'   Build Playorder info
'   GoTo Top
    Selection.HomeKey Unit:=wdStory
    
    Selection.Find.ClearFormatting
    With Selection.Find
        .Text = "Playorder: "
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute
    
    Selection.EndKey Unit:=wdLine, Extend:=wdMove
    Select Case VerseCnt
    Case 1
    Selection.TypeText Text:="v1"
    Case 2
    Selection.TypeText Text:="v1,v2"
    Case 3
    Selection.TypeText Text:="v1,v2,v3"
    Case 4
    Selection.TypeText Text:="v1,v2,v3,v4"
    Case 5
    Selection.TypeText Text:="v1,v2,v3,v4,v5"
    Case 6
    Selection.TypeText Text:="v1,v2,v3,v4,v5,v6"
    Case 7
    Selection.TypeText Text:="v1,v2,v3,v4,v5,v6,v7"
    Case 8
    Selection.TypeText Text:="v1,v2,v3,v4,v5,v6,v7,v8"
    Case 9
    Selection.TypeText Text:="v1,v2,v3,v4,v5,v6,v7,v8,v9"
    Case 10
    Selection.TypeText Text:="v1,v2,v3,v4,v5,v6,v7,v8,v9,v10"
    Case 11
    Selection.TypeText Text:="v1,v2,v3,v4,v5,v6,v7,v8,v9,v10,v11"
    Case 12
    Selection.TypeText Text:="v1,v2,v3,v4,v5,v6,v7,v8,v9,v10,v11,v12"
    Case 13
    Selection.TypeText Text:="v1,v2,v3,v4,v5,v6,v7,v8,v9,v10,v11,v12,v13"
    Case 14
    Selection.TypeText Text:="v1,v2,v3,v4,v5,v6,v7,v8,v9,v10,v11,v12,v13,v14"
    Case 15
    Selection.TypeText Text:="v1,v2,v3,v4,v5,v6,v7,v8,v9,v10,v11,v12,v13,v14,v15"
    Case Else
    Selection.TypeText Text:="v1,v2,v3,v4,v5,v6,v7,v8,v9,v10,v11,v12,v13,v14,v15,v16"
    End Select

'   Go to the top
    Selection.HomeKey Unit:=wdStory

'   Save the Shoutsinger text file
'    ActiveDocument.SaveAs FileName:=tempDocName, FileFormat:=wdFormatText
    ActiveDocument.Save
    ActiveDocument.Close

ExitSub:

End Sub