mass rename part duex

Sorry about multiple post, and I think I made it worse by trying to explain
in multiple replies (please forgive me)


Here is the jist of the issue
I need to take a bunch of files and be able to combine them into one
(append.dat) file (this will hold all the data from all the previous files)

These files need to be entered into the append.dat oldest first, then
removed, leaving only the append.dat file with all the information in one
file...

I am stuck and need assistance please.

This is what I have so far... (1) it does not remove files, (2) it does not
add the oldest first (3) and it adds all the files including the script and
append.dat into the append.dat if ran more than once.... Thanks for your help
in advance, and again sorry for the multiple post and confusion,.



Const ForReading = 1

Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objOutputFile = objFSO.CreateTextFile("append.dat")

strComputer = "."
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")

Set FileList = objWMIService.ExecQuery _
("ASSOCIATORS OF {Win32_Directory.Name='C:\temp\attp'} Where " _
& "ResultClass = CIM_DataFile")

For Each objFile In FileList
Set objTextFile = objFSO.OpenTextFile(objFile.Name, ForReading)
strText = objTextFile.ReadAll
objTextFile.Close
objOutputFile.WriteLine strText
Next

objOutputFile.Close

McKirahan
Mon Jan 02 16:43:16 CST 2006

"Rob" <Rob@discussions.microsoft.com> wrote in message
news:1C3C7699-0E93-48AC-9CF9-6FE9C229FF9C@microsoft.com...
> Sorry about multiple post, and I think I made it worse by trying to
explain
> in multiple replies (please forgive me)
>
>
> Here is the jist of the issue
> I need to take a bunch of files and be able to combine them into one
> (append.dat) file (this will hold all the data from all the previous
files)
>
> These files need to be entered into the append.dat oldest first, then
> removed, leaving only the append.dat file with all the information in one
> file...
>
> I am stuck and need assistance please.
>
> This is what I have so far... (1) it does not remove files, (2) it does
not
> add the oldest first (3) and it adds all the files including the script
and
> append.dat into the append.dat if ran more than once.... Thanks for your
help
> in advance, and again sorry for the multiple post and confusion,.
>

For the third time, which date do you want to be used to
determine the "oldest"?
DateCreated,
DateLastAccessed, or
DateLastModified.

I'l assume "DateLastModified".

Can you ensure that all files to be appended are text files?

Try this; watch for word-wrap.

Option Explicit
'*
'* Declare Constants
'*
Const cVBS = "append.vbs"
Const cDAT = "append.dat"
Const cFOL = "'C:\temp\attp\"
'*
'* Declare Variables
'*
Dim i, j, k
Dim arrSRT()
Dim strFIL
Dim intGFF
intGFF = 0
Dim strGFF
Dim intGFI
intGFI = 0
Dim strNOW
strNOW = Now
Dim intSEC
'*
'* Declare Objects
'*
Dim objFSO
Set objFSO = CreateObject("Scripting.FileSystemObject")
'If objFSO.FileExists(cFOL & cDAT) Then objFSO.DeleteFile(cFOL & cDAT)
Dim objGFI
Dim objGFO
Set objGFO = objFSO.GetFolder(cFOL)
Dim objGFF
Set objGFF = objGFO.Files
Dim objOT1
Dim objOT2
'*
'* Find Filenames
'*
For Each strGFF in objGFF
intGFF = intGFF + 1
'WScript.Echo intGFF & ". " & strGFF.Name
If strGFF.Name <> cDAT _
And strGFF.Name <> cVBS Then
Set objGFI = objFSO.GetFile(cFOL & strGFF.Name)
If objGFI.Size > 0 Then
intGFI = intGFI + 1
'WScript.Echo intGFI & ": " & strGFF.Name
intSEC = 1000000000 -
DateDiff("s",objGFI.DateLastModified,Now)
ReDim Preserve arrSRT(intGFI-1)
arrSRT(intGFI-1) = intSEC & "|" & strGFF.Name
End If
Set objGFI = Nothing
End If
Next
'*
'* Sort Filenames
'*
For i = UBound(arrSRT) - 1 To 0 Step -1
For j = 0 To i
If arrSRT(j) > arrSRT(j+1) Then
k = arrSRT(j+1)
arrSRT(j+1) = arrSRT(j)
arrSRT(j) = k
End If
Next
Next
'WScript.Echo Join(arrSRT,vbCrLf)
'*
'* Read Filenames
'*
Set objOT1 = objFSO.OpenTextFile(cFOL & cDAT, 8, True)
For i = 0 To UBound(arrSRT)
strFIL = Split(arrSRT(i),"|")(1)
'WScript.Echo (i+1) & "= " & strFIL
Set objOT2 = objFSO.OpenTextFile(cFOL & strFIL, 1)
objOT1.Write(objOT2.ReadAll)
Set objOT2 = Nothing
' objFSO.DeleteFile(cFOL & strFIL, True)
Next
Set objOT1 = Nothing
'*
'* Destroy Objects
'*
Set objGFF = Nothing
Set objGFO = Nothing
Set objFSO = Nothing
'*
'* Finish
'*
MsgBox intGFI & " files appended to" & vbCrLf & cFOL &
cDAT,vbInformation,cVBS


Currently is does not insert a line break (vbCrLf) after files
that do not end with one.

Several lines are commented out but vould be uncommented
for debugging.

The "DeleteFile" is file commented for your initial testing.

deckhopper
Thu Jan 05 05:23:06 CST 2006

Here's my version of code.
*Notes:
1. Put the vbs file in the same folder as where the text files are

2. Change the global variable "fileQueryPath" to point to the folder
you need

3. The code is commented for easier understanding

4. The code is built in modular functions and subroutines for easier
understanding and a more modular layout

5. The code takes into consideration the following:

a. If there are no text files, it recognizes that and quits

b. If the text file is empty, it recognizes that and moves on (instead
of crashing to an "End of File" error

c. If there is no DAT file, one is created. If a DAT already exists,
it is appended to

6. Uncomment the "deleteFiles" function-call to delete the files

' ######################################################
' Start Script
' ######################################################
Option Explicit

Dim objFSO, objOutputFile, objWMIService, objFile, objTextFile,
FileList
Dim objDatForAppending, textFilesExist
Dim fileQueryPath, strComputer, strText, datFile, datFilePath
Dim longName, shortName, fileExtensionName
Dim x, y, fileAttributes, strDetails, timeCreated
Dim arrFileNames(), arrCreatedTime(), arrCreatedDate(), arrCreated()

Const ForReading = 1
Const ForWriting = 2
Const ForAppending = 8

fileQueryPath = "c:\documents and
settings\administrator\desktop\vbtests"
strComputer = "."
datFile = "append.dat"

Set objFSO = CreateObject("Scripting.FileSystemObject")

Set objWMIService = GetObject("winmgmts:\\" & strComputer _
& "\root\cimv2")


createDatFile
buildFileNameArray
quitscript



' ******************************************************************
' Function createDatFile

' --> Creates the DAT file if one does not already exist. If the

' DAT file already exists, it opens it for APPENDING

' (it keeps the old data but adds the new data).
Function createDatFile

If Not(objFSO.FileExists(datFile)) Then
MsgBox "About to create DAT file!"
Set objOutputFile = objFSO.CreateTextFile(datFile)
datFilePath = objFSO.GetAbsolutePathName(datFile)
Else
MsgBox "DAT file already exists! Continuing..."
datFilePath = objFSO.GetAbsolutePathName(datFile)
Set objOutputFile = objFSO.OpenTextFile(datFilePath, ForAppending)
End If

End Function
' **********************************************************|



' *******************************************************************
' Sub buildFileNameArray

' --> Builds 4 dynamic arrays from files in the folder.

' 1. arrFileNames = array of Full Path to filename for each file

' 2. arrCreatedTime = array of "Time Created" for each file

' 3. arrCreatedDate = array of "Date Created" for each file

' 4. arrCreated = array of date AND time (together) for each file

' This part assumes you have no other filetype in the folder other than

' .txt, .dat, and .vbs files. Ends if no .txt files are in the folder.
Sub buildFileNameArray

Dim w, z
y=0

Set FileList = objWMIService.ExecQuery _
("ASSOCIATORS OF {Win32_Directory.Name='" & fileQueryPath &"'}
Where " _
& "ResultClass = CIM_DataFile")

For Each objFile In FileList
longName = objFile.Name
shortName = objFSO.GetFileName(longName)
fileExtensionName = objFSO.GetExtensionName(shortName)

If fileExtensionName = "txt" Then
textFilesExist = True
ReDim Preserve arrFileNames(y)
ReDim Preserve arrCreatedTime(y)
ReDim Preserve arrCreatedDate(y)
ReDim Preserve arrCreated(y)
arrFileNames(y) = longName
arrCreated(y) = getCreationDateTime(longName)
arrCreatedTime(y) = TimeValue(getCreationDateTime(longName))
arrCreatedDate(y) = DateValue(getCreationDateTime(longName))
y = y + 1
Else
textFilesExist = False
End If
Next

' ~~~~~~~ START FOR-LOOP TEST ~~~~~~~~~~~~~~~~~~
' This For-Loop is here for testing. It shows a msgbox of the files.
' It is for testing purposes.
' Do not use this section if you have more than 10 files in a folder.
' MSGBOX can only hold a limited amount of characters.
'
' For w = 0 To UBound(arrFileNames)
' z = z & arrFileNames(w) & vbCr _
' & arrCreatedTime(w) & vbCr _
' & arrCreatedDate(w) & vbCr _
' & arrCreated(w) & vbCr _
' & vbCr & vbCr
' Next
'
' MsgBox z, 0, "This is the UNSORTED array of FileNames"
'
' ~~~~~~~ END FOR-LOOP TEST ~~~~~~~~~~~~~~~~~~~

If (textFilesExist) Then
sortByCreationDateTime arrFileNames, _
arrCreatedTime, arrCreatedDate, arrCreated
Else
MsgBox "There are NO text files to read", 0, "No text files found"
quitscript
End If

End Sub
' *****************************************************|



' *********************************************************************
' Function getCreationDateTime

' --> Retrieves the Date/Time of DateCreated for each file
Function getCreationDateTime(fullFilePath)

Set fileAttributes = objFSO.GetFile(fullFilePath)
strDetails = fileAttributes.DateCreated
getCreationDateTime = strDetails

End Function
' ***************************************************|



' ********************************************************************
' Function sortByCreationDateTime
' --> Sorts the files based on their age (oldest first)

' Commonly known as a bubble-sort because you bubble-up

' (or down in this case) the file you want up top.
Function sortByCreationDateTime(fxname, fxtime, fxdate, fxcreated)

' *Note:

' To sort from newest to oldest, use the '<' comparison operator

' To sort from oldest to newest, use the '>' comparison operator

Dim w, z, t, result, temp1, temp2, temp3, temp4
t = 0

Do While t <> UBound(fxname)
For w = 0 To UBound(fxname)
If w <> UBound(fxname) Then
result = fxcreated(w) > fxcreated(w+1)
If (result) Then
temp1 = fxname(w)
temp2 = fxcreated(w)
temp3 = fxtime(w)
temp4 = fxdate(w)
fxname(w) = fxname(w+1)
fxcreated(w) = fxcreated(w+1)
fxtime(w) = fxtime(w+1)
fxdate(w) = fxdate(w+1)
fxname(w+1) = temp1
fxcreated(w+1) = temp2
fxtime(w+1) = temp3
fxdate(w+1) = temp4
End If
End If
If w = UBound(fxname) Then
result = fxcreated(w-1) > fxcreated(w)
If (result) Then
temp1 = fxname(w-1)
temp2 = fxcreated(w-1)
temp3 = fxtime(w-1)
temp4 = fxdate(w-1)
fxname(w-1) = fxname(w)
fxcreated(w-1) = fxcreated(w)
fxtime(w-1) = fxtime(w)
fxdate(w-1) = fxdate(w)
fxname(w) = temp1
fxcreated(w) = temp2
fxtime(w) = temp3
fxdate(w) = temp4
End If
End If
Next
t = t + 1
Loop

' ~~~~~~~ START FOR-LOOP TEST ~~~~~~~~~~~~~~~~
' This For-Loop is here for testing.

' It shows a msgbox of the files. Only for testing purposes.

' Do not use this section if you have more than 10 files.

' MSGBOX can only hold a limited amount of characters.

' For w = 0 To UBound(fxname)
' z = z & fxname(w) & vbCr _
' & fxtime(w) & vbCr _
' & fxdate(w) & vbCr _
' & fxcreated(w) & vbCr _
' & vbCr & vbCr
' Next

' MsgBox z, 0, "This is the SORTED list of FileNames"

' ~~~~~~~ END FOR-LOOP TEST ~~~~~~~~~~~~~~~~~

readFiles(fxname)
' deleteFiles(fxname)

End Function
' ******************************************************|



' ******************************************************************
' Function readFiles

' --> Runs through the sorted array (oldest first)

' Reads each files' contents then appends to "append.dat"

' After each contents are written, a delimeter line is made:

' --> "---------------"

' This function also considers if the text is empty (blank).

' Otherwise, the system throws an error

' If it tries to "ReadAll" when there is nothing to read.
Function readFiles(fxLongFilePath)

Dim nothingVariable

For x=0 To UBound(fxLongFilePath)
longName = objFSO.GetAbsolutePathName(fxLongFilePath(x))
shortName = objFSO.GetFileName(longName)
fileExtensionName = objFSO.GetExtensionName(shortName)

If fileExtensionName = "txt" Then
Set objTextFile = objFSO.OpenTextFile(longName, ForReading)
If (objTextFile.AtEndOfStream) Then
nothingVariable = 2 + 2
Else
strText = objTextFile.ReadAll
objTextFile.Close
objOutputFile.WriteLine strText & vbCr & "-----------------"
End If
End If
Next

objOutputFile.Close

End Function
' *****************************************************|



' *****************************************************************
' Function deleteFiles

' --> Deletes ".txt" files only
Function deleteFiles(fxLongFilePath)

For x=0 To UBound(fxLongFilePath)
longName = objFSO.GetAbsolutePathName(fxLongFilePath(x))
If objFSO.FileExists(longName) Then
objFSO.DeleteFile(longName)
End If
Next

End Function
' ****************************************************|



' *****************************************************************
' Sub quitscript

' --> A handy way to let the user know we are quitting
Sub quitscript

MsgBox "Quitting Now"
Wscript.Quit

End Sub
' ****************************************************|

' #############################################
' End Script
' #############################################