Sub sb_KeyWords()
Dim fso As FileSystemObject
Dim strR As TextStream, strW As TextStream
Dim i%, j%, k%, iQty%, iW_Lines%(3), iW_Words%(3), iFormat%
Dim sPath$, sFileR$, sFileW$, sDlm$, sSfx$, sExt$, sSrc$(), sTgt$
' USER DATA SETUP
iW_Lines(1) = 20: iW_Lines(2) = 30 ' Low & Upper bounds of lines in target file
iW_Words(1) = 3: iW_Words(2) = 6 ' Low & Upper bounds of elements in line
sPath = "C:\Path1\Path2\Path3" ' type real path here w/o ending slash
sFileR = "TextPhrases" ' Name of sourse file
sSfx = "Rnd" ' Suffix of target file
sExt = "txt" ' A same extension for both of files
sDlm = "," ' Delimiter
iFormat = TristateUseDefault ' -2 - Opens the file using the system default
' iFormat = TristateMixed ' -2 - Opens the file using the system default
' iFormat = TristateTrue ' -1 - Opens the file as Unicode
' iFormat = TristateFalse ' 0 - Opens the file as ASCII
' PROCEDURE
sFileW = sFileR & "_" & sSfx
sFileR = sPath & "\" & sFileR & "." & sExt
sFileW = sPath & "\" & sFileW & "." & sExt
Set fso = CreateObject("Scripting.FileSystemObject")
With fso
Set strR = .OpenTextFile(sFileR, ForReading, , iFormat)
With strR
Do While Not .AtEndOfStream
iQty = iQty + 1
ReDim Preserve sSrc(1 To iQty)
sSrc(iQty) = .ReadLine
Loop
End With
Set strW = .OpenTextFile(sFileW, ForWriting, True, iFormat)
Randomize (Timer + 1) ' (GetTickCount)
iW_Lines(0) = Int((iW_Lines(2) - iW_Lines(1) + 1) * Rnd + iW_Lines(1))
For i = 1 To iW_Lines(0)
Randomize (Timer + 2) ' (GetTickCount)
iW_Words(0) = Int((iW_Words(2) - iW_Words(1) + 1) * Rnd + iW_Words(1))
sTgt = ""
Randomize (Timer + 3) ' (GetTickCount)
For j = 1 To iW_Words(0)
k = Int((iQty - 1 + 1) * Rnd + 1)
sTgt = sTgt & sDlm & Trim(sSrc(k))
Next
sTgt = Right(sTgt, Len(sTgt) - 1)
strW.WriteLine (sTgt)
Next
End With
MsgBox "OK"
End Sub
|
