&Секция1
~поле1:значение
~поле2:значение
~поле3:значение
&Секция2
~поле1:значение
~поле2:значение
~поле3:значение

&Section1
~Field1:Value
~Field2:Value
....
~FieldN:Value
&Section2
~Field1:Value
~Field2:Value
....
~FieldN:Value
...
&SectionN
~Field1:Value
~Field2:Value
....
~FieldN:Value

Const ForReading =  1 
Const ForWriting =  2 

Const strSourceFile="C:\Temp\source.txt",strDestFile="C:\Temp\dest.txt"
Const strSectionStartString="&Section"
Const strSectionFieldString="~Field"

Dim objFSO,objSourceFile,objDestFile
Dim strLine,strCurrentSection,strFieldName,strFieldValue,blnNewSection,intPos

blnNewSection=False
strCurrentSection=""
Set objFSO=CreateObject("Scripting.FileSystemObject")
If objFSO.FileExists(strSourceFile)
	Set objSourceFile=objFSO.OpenTextFile(strSourceFile,ForReading)
	Set objOutputFile=objFSO.OpenTextFile(strDestFile,ForWriting,True)
	Do While Not objSourceFile.AtEndOfStream
		strLine=objSourceFile.ReadLine
		If strLine<>strCurrentSection Then blnNewSection=True
		If Left(strLine,Len(strSectionStartString))=strSectionStartString Then
			strCurrentSection=strLine
		ElseIf Left(strLine,Len(strSectionFieldString))=strSectionFieldString Then
			If blnNewSection Then
				blnNewSection=False
				intPos=InStr( 1 ,strLine,":")
				strFieldName=Mid(strLine, 2 ,intPos- 1 )
				strFieldValue=Mid(strLine,intPos+ 1 )
				objOutputFile.Write("#" & Right(strCurrentSection,Len(strCurrentSection)- 1 ) & ":" & strFieldName & ":" & strFieldValue)
			Else
				objOutputFile.WriteLine("#" & Right(strCurrentSection,Len(strCurrentSection)- 1 ) & ":" & strFieldName & ":" & strFieldValue)
			End If
		End If
	Loop
	objSourceFile.Close
	objDestFile.Close
	Set objSourceFile=Nothing
	Set objDestFile=Nothing
End If
Set objFSO=Nothing