Split a Text File - Rename With the Original Text Heading Found in file

[dj44]

Folks,

a very good day and evening to all.:)

I found this very good macro that I wanted to use, but even then I managed to jumble it all up.

I will tell you the quick story.

One time I lost all my macros - now that was a disaster.

So Ive put them in a text file for safe keeping.

I need to split them now as I was too ambitious and need to use some of them.

So my large text file has all my macros in them.


I wanted to split them and rename them with the original sub heading - that becomes the name of the file



Sub DeleteSheets() >> DeleteSheets.txt

Sub MergeWorkbooks() >> MergeWorkbooks.txt

etc

http://www.vbaexpress.com/forum/showthread.php?32361-Extract-to-multiple-text-files



Sub SplitATextFileintoIndividualOnes()

Found on the forum - to split the text file
'http://www.vbaexpress.com/forum/showthread.php?32361-Extract-to-multiple-text-files

Dim tName As String
Dim fName As String
Dim Pth As String
Dim fs, f, a
Dim txt As String
Dim i As Long

Const ForReading = 1, ForWriting = 2, ForAppending = 3
Pth = ActiveWorkbook.Path & "\"
Set fs = CreateObject("Scripting.FileSystemObject")

Set f = fs.OpenTextFile(Pth & "DJImportantMacros.txt", ForReading) ' My macro file is here

txt = f.ReadAll
f.Close
Set f = Nothing

a = Split(txt, "Sub ") & ' Each macro name will be the file name of the text file
For i = 1 To UBound(a)
fName = Trim(Split(a(i), "Sub")(0))
fName = Left(fName, Len(fName) - 2) & ".txt" ' take off the () from the left



Set f = fs.CreateTextFile(Pth & fName, True)
f.write "Sub" & a(i)
f.Close
Next
Set f = Nothing
Set fs = Nothing

End Sub


I tried the shell scripts found on the stack, but they didn't work, then i tried the bat file, and some cmd code , so had a long arduous Sunday trying to split these dratted files, to no fruition :mad:

I looked for text splitter software but found zilch.

I don't understand - don't people split text files? :confused:

If any good person can help this case - I am very grateful

thanks folks and every one have a good Monday :)

my gratitude for your good grace
DJ

[excelliot]

Hi try this...



Option Compare Text
Sub SplitATextFileintoIndividualOnes()

'Found on the forum - To split the text file
'http://www.vbaexpress.com/forum/showthread.php?32361-Extract-to-multiple-text-files

Dim tName As String
Dim fName As String
Dim Pth As String
Dim fs, f, a
Dim txt As String
Dim i As Long

Const ForReading = 1, ForWriting = 2, ForAppending = 3
Pth = ActiveWorkbook.Path & "\"
Set fs = CreateObject("Scripting.FileSystemObject")

Set f = fs.OpenTextFile(Pth & "DJImportantMacros.txt", ForReading) ' My macro file is here

txt = f.ReadAll
f.Close
Set f = Nothing

a = Split(txt, "sub ") ' Each macro name will be the file name of the text file
For i = 1 To UBound(a)
fName = Trim(Split(a(i), "sub")(0))
fName = Trim(Split(a(i), "(")(0)) & ".txt" ' take off the () from the left



Set f = fs.CreateTextFile(Pth & fName, True)
f.write "Sub " & a(i)
f.Close
Next
Set f = Nothing
Set fs = Nothing

End Sub


Cheers!!

[excelliot]

note that you need to have
Option Compare Text in the beginning so that Sub or sub will be treated as same...

[dj44]

Hello excelliot,

what a good man you are, its done the job like a treat. :friends:

I spent the whole day yesterday in stress


Thank you ever so much - it split the text file - like a pro software

If I may just have a follow up question - I realise now that above the sub title it has this line.

Attribute VB_Name = "Delete_Worksheets_From_WB"

if i lose that line - then I have to rename all the modules each time.



How can I have the option to save with this title instead




a = Split(txt, "Attribute VB_Name ") ' Each macro name will be the file name of the text file
For i = 1 To UBound(a)
fName = Trim(Split(a(i), "Attribute VB_Name")(0))
fName = Trim(Split(a(i), "(")(0)) & ".txt" ' take off the () from the left



thank you for your tremendous help:thumb

dj

[excelliot]

ok, then you need to modify your code as below:



Option Compare Text
'Compare mode is not case sensitive, default mode is binary which is case sensitive
Sub Split_2_ATextFileintoIndividualOnes()

'Found on the forum - To split the text file
'http://www.vbaexpress.com/forum/showthread.php?32361-Extract-to-multiple-text-files

Dim tName As String
Dim fName As String
Dim Pth As String
Dim fs, f, a
Dim txt As String
Dim i As Long

Const ForReading = 1, ForWriting = 2, ForAppending = 3
Pth = ActiveWorkbook.Path & "\"
Set fs = CreateObject("Scripting.FileSystemObject")

Set f = fs.OpenTextFile(Pth & "DJImportantMacros.txt", ForReading) ' My macro file is here

txt = f.ReadAll
f.Close
Set f = Nothing

a = Split(txt, "Attribute VB_Name ") ' Each macro name will be the file name of the text file
For i = 1 To UBound(a)
fName = Trim(Split(a(i), """")(1))
'fName = Trim(Split(a(i), "(")(0)) & ".txt" ' take off the () from the left
fName = fName & ".txt" ' take off the () from the left



Set f = fs.CreateTextFile(Pth & fName, True)
f.write "Attribute VB_Name " & a(i)
f.Close
Next
Set f = Nothing
Set fs = Nothing

End Sub


Cheers!!

[dj44]

Dear excelliot,

May I salute you for your generous and mighty help.

It split my macros like a treat - I am very very pleased.

My macro text file was very long so it worked on it good.:checkmark

now I tried that powershell - but that was a disaster, so i left it, and there was no other software to do this job:angry:

I will learn to use this macro code to split some other files.


- thank you for helping me again :grinhalo:

You have a great Tuesday now

buddy cheers :hifive:

DJ

[snb]

Sub M_snb()
with CreateObject("Scripting.FileSystemObject")
sn=split(.OpenTextFile(thisworkbook.path & "\DJImportantMacros.txt").readall,"Attribute VB_Name ")

for j=0 to ubound(sn)
.creatextfile(thisworkbook.path & "\" & split(sn(j),string(2,chr(34)))(1) & ".txt").write "Attribute VB_Name " & sn(j)
next
end with
end sub

[excelliot]

Dear excelliot,

May I salute you for your generous and mighty help.

It split my macros like a treat - I am very very pleased.

My macro text file was very long so it worked on it good.:checkmark

now I tried that powershell - but that was a disaster, so i left it, and there was no other software to do this job:angry:

I will learn to use this macro code to split some other files.


- thank you for helping me again :grinhalo:

You have a great Tuesday now

buddy cheers :hifive:

DJ

Glad this helped.

Cheers!

[dj44]

Thank you snb,

I got another tool as well now:grinhalo:

take it for a spin run

dj