HI again.
After my last thread on NEO+G for Dummies, I realised that some of the less "computerate" amongst the congreagation might have difficulty with the method I explained to get a successful NEO+G DVD.
So, I set out to see if it could be done by an easier and hopefully largely automated procedure.
I believe I now have a method that is simple and very quick to generate the required import file for the NEO+G production software.
The next post will go over the software requirements and overview the method.
Sandy
NEO+G for Dummies part deux
Re: NEO+G for Dummies part deux
Hi again.
As in the previous thread, you will need the following software;
RMC.EXE, the NEO+G authoring tool from here; www.rsqaudio.com
Microsoft Excel.
ExplorerXP from here; www.explorerxp.com/
Any DVD data burning software of your choice.
You will notice that the software required is reduced but is now VERY specific.
This is because the method I have adopted uses Excel Visual Basic for Applications (VBA) and I'm not sure if other spreadsheets will support the code.
The method requires the making of folders and sub-folders, as before but Excel will now do the "donkey" work.
1) as before is to make a "Parent" folder on your hard drive.
2) in your Parent folder make 3 sub-folders for CDG, MP3 and text files. I used neo_mp3, neo_cdg and neo_text for my subfolder names and I suggest strongly that YOU do the same as Excel will perform some renaming operations and standard names makes life easier.
3) copy your MP3+G files into their appropriate folders, i.e. MP3's into neo_mp3 and CDG's into neo_cdg.
4) Use ExplorerXP on both folders to remove ALL commas from your filenames. Consult the earlier thread for instructions.
If you have done this, proceed to the next step.
Sandy
As in the previous thread, you will need the following software;
RMC.EXE, the NEO+G authoring tool from here; www.rsqaudio.com
Microsoft Excel.
ExplorerXP from here; www.explorerxp.com/
Any DVD data burning software of your choice.
You will notice that the software required is reduced but is now VERY specific.
This is because the method I have adopted uses Excel Visual Basic for Applications (VBA) and I'm not sure if other spreadsheets will support the code.
The method requires the making of folders and sub-folders, as before but Excel will now do the "donkey" work.
1) as before is to make a "Parent" folder on your hard drive.
2) in your Parent folder make 3 sub-folders for CDG, MP3 and text files. I used neo_mp3, neo_cdg and neo_text for my subfolder names and I suggest strongly that YOU do the same as Excel will perform some renaming operations and standard names makes life easier.
3) copy your MP3+G files into their appropriate folders, i.e. MP3's into neo_mp3 and CDG's into neo_cdg.
4) Use ExplorerXP on both folders to remove ALL commas from your filenames. Consult the earlier thread for instructions.
If you have done this, proceed to the next step.
Sandy
Hi again,
here is the VBA code you will use with Excel to get the job done;
Public X()
Public i As Long
Public objShell, objFolder, objFolderItem
Public FSO, oFolder, Fil
Sub MainExtractData()
Dim NewSht As Worksheet
Dim MainFolderName As String
Dim TimeLimit As Long, StartTime As Double
Dim textartist As String
Dim textsong As String
Dim textsep As String
Dim textpath As String
Dim texttitle As String
Dim count As Integer
textsep = "/"
ReDim X(1 To 65536, 1 To 11)
Set objShell = CreateObject("Shell.Application")
'TimeLimit = Application.InputBox("Please enter the maximum time that you wish this code to run for in minutes" & vbNewLine & vbNewLine & _
"Leave this at zero for unlimited runtime", "Time Check box", 0)
'StartTime = Timer
Application.ScreenUpdating = False
MainFolderName = BrowseForFolder()
Set NewSht = ThisWorkbook.Sheets.Add
'X(1, 1) = "Path"
'X(1, 2) = "File Name"
i = 1
Set FSO = CreateObject("scripting.FileSystemObject")
Set oFolder = FSO.GetFolder(MainFolderName)
'error handling to stop the obscure error that occurs at time when retrieving DateLastAccessed
On Error Resume Next
For Each Fil In oFolder.Files
Set objFolder = objShell.Namespace(oFolder.Path)
Set objFolderItem = objFolder.ParseName(Fil.Name)
i = i + 1
If i Mod 20 = 0 And TimeLimit <> 0 And Timer > (TimeLimit * 60 + StartTime) Then
GoTo FastExit
End If
If i Mod 50 = 0 Then
Application.StatusBar = "Processing File " & i
DoEvents
End If
X(i, 1) = oFolder.Path
X(i, 2) = Fil.Name
Next
'Get subdirectories
If TimeLimit = 0 Then
Call RecursiveFolder(oFolder, 0)
Else
If Timer < (TimeLimit * 60 + StartTime) Then Call RecursiveFolder(oFolder, TimeLimit * 60 + StartTime)
End If
FastExit:
Range("A:K") = X
If i < 65535 Then Range(Cells(i + 1, "A"), Cells(65536, "A")).EntireRow.Delete
Range("A:K").WrapText = False
Range("A:K").EntireColumn.AutoFit
Range("1:1").Font.Bold = True
Rows("2:2").Select
ActiveWindow.FreezePanes = True
Range("a1").Activate
Set FSO = Nothing
Set objShell = Nothing
Set oFolder = Nothing
Set objFolder = Nothing
Set objFolderItem = Nothing
Set Fil = Nothing
Application.StatusBar = ""
Application.ScreenUpdating = True
'Enter additional code here
Rows("1:1").Select 'Remove top row
Selection.Delete Shift:=xlUp
Range("A1").Select
Columns("A:B").Select 'Move columns A & B to C
Selection.Cut
Range("C1").Select
ActiveSheet.Paste
Range("C1").Select
ActiveWindow.FreezePanes = False 'unfreeze the pane
count = 1
Do While Cells(count, 3) <> ""
Cells(count, 5) = "FALSE"
textpath = Cells(count, 3)
texttitle = Cells(count, 4)
Cells(count, 7) = textpath + textsep + texttitle
Cells(count, 6) = Cells(count, 7)
count = count + 1
Loop
Columns("C:D").Select
Selection.ClearContents
Columns("F:F").Select
Selection.Replace What:="mp3", Replacement:="cdg", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False
count = 1
Do While Cells(count, 5) <> ""
Text = Cells(count, 6)
Cells(count, 3) = Right(Text, Len(Text) - (InStr(Text, " - ") + 2))
count = count + 1
Loop
count = 1
Do While Cells(count, 3) <> ""
Text = Cells(count, 3)
Cells(count, 1) = Right(Text, Len(Text) - (InStr(Text, " - ") + 2))
count = count + 1
Loop
count = 1
Do While Cells(count, 3) <> ""
Text = Cells(count, 3)
Cells(count, 2) = Left(Text, InStr(Text, " - "))
count = count + 1
Loop
Columns("A:A").Select
Selection.Replace What:=".cdg", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False
Columns("C:C").Select
Selection.ClearContents
Cells.Select
Selection.ColumnWidth = 10
Cells.Select
Cells.EntireColumn.AutoFit
Range("A1").Select
End Sub
Sub RecursiveFolder(xFolder, TimeTest As Long)
Dim SubFld
For Each SubFld In xFolder.SubFolders
Set oFolder = FSO.GetFolder(SubFld)
Set objFolder = objShell.Namespace(SubFld.Path)
For Each Fil In SubFld.Files
Set objFolder = objShell.Namespace(oFolder.Path)
'Problem with objFolder at times
If Not objFolder Is Nothing Then
Set objFolderItem = objFolder.ParseName(Fil.Name)
i = i + 1
If i Mod 20 = 0 And TimeTest <> 0 And Timer > TimeTest Then
Exit Sub
End If
If i Mod 50 = 0 Then
Application.StatusBar = "Processing File " & i
DoEvents
End If
X(i, 1) = SubFld.Path
X(i, 2) = Fil.Name
Else
Debug.Print Fil.Path & " " & Fil.Name
End If
Next
Call RecursiveFolder(SubFld, TimeTest)
Next
End Sub
Function BrowseForFolder(Optional OpenAt As Variant) As Variant
'Function purpose: To Browse for a user selected folder.
'If the "OpenAt" path is provided, open the browser at that directory
'NOTE: If invalid, it will open at the Desktop level
Dim ShellApp As Object
'Create a file browser window at the default folder
Set ShellApp = CreateObject("Shell.Application"). _
BrowseForFolder(0, "Please choose a folder", 0, OpenAt)
'Set the folder to that selected. (On error in case cancelled)
On Error Resume Next
BrowseForFolder = ShellApp.self.Path
On Error GoTo 0
'Destroy the Shell Application
Set ShellApp = Nothing
'Check for invalid or non-entries and send to the Invalid error
'handler if found
'Valid selections can begin L: (where L is a letter) or
'\\ (as in \\servername\sharename. All others are invalid
Select Case Mid(BrowseForFolder, 2, 1)
Case Is = ":"
If Left(BrowseForFolder, 1) = ":" Then GoTo Invalid
Case Is = "\"
If Not Left(BrowseForFolder, 1) = "\" Then GoTo Invalid
Case Else
GoTo Invalid
End Select
Exit Function
Invalid:
'If it was determined that the selection was invalid, set to False
BrowseForFolder = False
End Function
Copy and paste ALL the code from Public() to End Function into Notepad and save it on your PC as a text file.
Open Excel and when fired up, press Ctrl + F11
This will open the Visual Basic Editor.
Click "Insert" at top of screen and select "Module", when the Macro window will open.
Open your saved text file containing the code and copy and paste it into the Macro window.
Sandy
here is the VBA code you will use with Excel to get the job done;
Public X()
Public i As Long
Public objShell, objFolder, objFolderItem
Public FSO, oFolder, Fil
Sub MainExtractData()
Dim NewSht As Worksheet
Dim MainFolderName As String
Dim TimeLimit As Long, StartTime As Double
Dim textartist As String
Dim textsong As String
Dim textsep As String
Dim textpath As String
Dim texttitle As String
Dim count As Integer
textsep = "/"
ReDim X(1 To 65536, 1 To 11)
Set objShell = CreateObject("Shell.Application")
'TimeLimit = Application.InputBox("Please enter the maximum time that you wish this code to run for in minutes" & vbNewLine & vbNewLine & _
"Leave this at zero for unlimited runtime", "Time Check box", 0)
'StartTime = Timer
Application.ScreenUpdating = False
MainFolderName = BrowseForFolder()
Set NewSht = ThisWorkbook.Sheets.Add
'X(1, 1) = "Path"
'X(1, 2) = "File Name"
i = 1
Set FSO = CreateObject("scripting.FileSystemObject")
Set oFolder = FSO.GetFolder(MainFolderName)
'error handling to stop the obscure error that occurs at time when retrieving DateLastAccessed
On Error Resume Next
For Each Fil In oFolder.Files
Set objFolder = objShell.Namespace(oFolder.Path)
Set objFolderItem = objFolder.ParseName(Fil.Name)
i = i + 1
If i Mod 20 = 0 And TimeLimit <> 0 And Timer > (TimeLimit * 60 + StartTime) Then
GoTo FastExit
End If
If i Mod 50 = 0 Then
Application.StatusBar = "Processing File " & i
DoEvents
End If
X(i, 1) = oFolder.Path
X(i, 2) = Fil.Name
Next
'Get subdirectories
If TimeLimit = 0 Then
Call RecursiveFolder(oFolder, 0)
Else
If Timer < (TimeLimit * 60 + StartTime) Then Call RecursiveFolder(oFolder, TimeLimit * 60 + StartTime)
End If
FastExit:
Range("A:K") = X
If i < 65535 Then Range(Cells(i + 1, "A"), Cells(65536, "A")).EntireRow.Delete
Range("A:K").WrapText = False
Range("A:K").EntireColumn.AutoFit
Range("1:1").Font.Bold = True
Rows("2:2").Select
ActiveWindow.FreezePanes = True
Range("a1").Activate
Set FSO = Nothing
Set objShell = Nothing
Set oFolder = Nothing
Set objFolder = Nothing
Set objFolderItem = Nothing
Set Fil = Nothing
Application.StatusBar = ""
Application.ScreenUpdating = True
'Enter additional code here
Rows("1:1").Select 'Remove top row
Selection.Delete Shift:=xlUp
Range("A1").Select
Columns("A:B").Select 'Move columns A & B to C
Selection.Cut
Range("C1").Select
ActiveSheet.Paste
Range("C1").Select
ActiveWindow.FreezePanes = False 'unfreeze the pane
count = 1
Do While Cells(count, 3) <> ""
Cells(count, 5) = "FALSE"
textpath = Cells(count, 3)
texttitle = Cells(count, 4)
Cells(count, 7) = textpath + textsep + texttitle
Cells(count, 6) = Cells(count, 7)
count = count + 1
Loop
Columns("C:D").Select
Selection.ClearContents
Columns("F:F").Select
Selection.Replace What:="mp3", Replacement:="cdg", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False
count = 1
Do While Cells(count, 5) <> ""
Text = Cells(count, 6)
Cells(count, 3) = Right(Text, Len(Text) - (InStr(Text, " - ") + 2))
count = count + 1
Loop
count = 1
Do While Cells(count, 3) <> ""
Text = Cells(count, 3)
Cells(count, 1) = Right(Text, Len(Text) - (InStr(Text, " - ") + 2))
count = count + 1
Loop
count = 1
Do While Cells(count, 3) <> ""
Text = Cells(count, 3)
Cells(count, 2) = Left(Text, InStr(Text, " - "))
count = count + 1
Loop
Columns("A:A").Select
Selection.Replace What:=".cdg", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False
Columns("C:C").Select
Selection.ClearContents
Cells.Select
Selection.ColumnWidth = 10
Cells.Select
Cells.EntireColumn.AutoFit
Range("A1").Select
End Sub
Sub RecursiveFolder(xFolder, TimeTest As Long)
Dim SubFld
For Each SubFld In xFolder.SubFolders
Set oFolder = FSO.GetFolder(SubFld)
Set objFolder = objShell.Namespace(SubFld.Path)
For Each Fil In SubFld.Files
Set objFolder = objShell.Namespace(oFolder.Path)
'Problem with objFolder at times
If Not objFolder Is Nothing Then
Set objFolderItem = objFolder.ParseName(Fil.Name)
i = i + 1
If i Mod 20 = 0 And TimeTest <> 0 And Timer > TimeTest Then
Exit Sub
End If
If i Mod 50 = 0 Then
Application.StatusBar = "Processing File " & i
DoEvents
End If
X(i, 1) = SubFld.Path
X(i, 2) = Fil.Name
Else
Debug.Print Fil.Path & " " & Fil.Name
End If
Next
Call RecursiveFolder(SubFld, TimeTest)
Next
End Sub
Function BrowseForFolder(Optional OpenAt As Variant) As Variant
'Function purpose: To Browse for a user selected folder.
'If the "OpenAt" path is provided, open the browser at that directory
'NOTE: If invalid, it will open at the Desktop level
Dim ShellApp As Object
'Create a file browser window at the default folder
Set ShellApp = CreateObject("Shell.Application"). _
BrowseForFolder(0, "Please choose a folder", 0, OpenAt)
'Set the folder to that selected. (On error in case cancelled)
On Error Resume Next
BrowseForFolder = ShellApp.self.Path
On Error GoTo 0
'Destroy the Shell Application
Set ShellApp = Nothing
'Check for invalid or non-entries and send to the Invalid error
'handler if found
'Valid selections can begin L: (where L is a letter) or
'\\ (as in \\servername\sharename. All others are invalid
Select Case Mid(BrowseForFolder, 2, 1)
Case Is = ":"
If Left(BrowseForFolder, 1) = ":" Then GoTo Invalid
Case Is = "\"
If Not Left(BrowseForFolder, 1) = "\" Then GoTo Invalid
Case Else
GoTo Invalid
End Select
Exit Function
Invalid:
'If it was determined that the selection was invalid, set to False
BrowseForFolder = False
End Function
Copy and paste ALL the code from Public() to End Function into Notepad and save it on your PC as a text file.
Open Excel and when fired up, press Ctrl + F11
This will open the Visual Basic Editor.
Click "Insert" at top of screen and select "Module", when the Macro window will open.
Open your saved text file containing the code and copy and paste it into the Macro window.
Sandy
Hi again,
nearly there.
Assuming you have copied your code into the Macro window, now click the "X" at top right to close the VB Editor (N.B. this will NOT close Excel, so don't panic.)
Now click "Tools" at top of screen, select Macro(s) and in the dialogue box select the MainExtractData marco and click "Run"
An Expolorer style window will open so browse to your neo_mp3 folder and click OK
Excel will now generate a spreadsheet in a format that the NEO+G software will accept. (My PC took less than 2 seconds to do this with 150 files as a sample).
Now click "File", select "Save as" and select "csv" in the option box.
Save your csv file to your neo_text folder (any name will do)
Using the instructions from the earlier thread, import and generate your NEO+G files.
Burn to DVD.
Enjoy.
Sandy
nearly there.
Assuming you have copied your code into the Macro window, now click the "X" at top right to close the VB Editor (N.B. this will NOT close Excel, so don't panic.)
Now click "Tools" at top of screen, select Macro(s) and in the dialogue box select the MainExtractData marco and click "Run"
An Expolorer style window will open so browse to your neo_mp3 folder and click OK
Excel will now generate a spreadsheet in a format that the NEO+G software will accept. (My PC took less than 2 seconds to do this with 150 files as a sample).
Now click "File", select "Save as" and select "csv" in the option box.
Save your csv file to your neo_text folder (any name will do)
Using the instructions from the earlier thread, import and generate your NEO+G files.
Burn to DVD.
Enjoy.
Sandy
Hi again,
just noticed a minor problem that is nothing to do with the code but the way "Smilies" are generated on the forum.
About half way down the code, you will see this;
Columns("C:D").Select
Selection.ClearContents
Columns("F:F").Select
Selection.Replace What:="mp3", Replacement:="cdg", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False
The smilie is not what should be there and I can't figure a way to get it to display correctly in the post.
However, if you look down a couple of lines, you will see ("F:F") You need to replace the smilie with a D with a colon in front of it.
Sandy
just noticed a minor problem that is nothing to do with the code but the way "Smilies" are generated on the forum.
About half way down the code, you will see this;
Columns("C:D").Select
Selection.ClearContents
Columns("F:F").Select
Selection.Replace What:="mp3", Replacement:="cdg", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False
The smilie is not what should be there and I can't figure a way to get it to display correctly in the post.
However, if you look down a couple of lines, you will see ("F:F") You need to replace the smilie with a D with a colon in front of it.
Sandy
Hi Wiseguy.wiseguy wrote:Sandy, if you check the box beside "Disable Smilies in this post" (not available with the Quick Reply) it should eliminate the unwanted emoticon in your post.
I believe the term is RTFM
Staring me in the face when I typed this reply (Duh!!!).Thanks for the information.
Also, I'd point out that I've tested the code in Excel 2000, 2002, 2003 and 2007 and all seems to work OK.
I should also have pointed out that when you run the macro, you MUST choose the mp3 folder as your source as the code replaces mp3 with cdg in some fields.
I'd appreciate anyone who has a NEO+G machine to have a go and let me know how they get on.
Sandy
