Saturday, February 11, 2006

Write NewLine Local File/Enum Folders


Option Explicit

Dim objShell,objFSO,objWMIService
Dim arrFolders(),rmtFile()
Dim strComputer,folder01,folder02,y,temp

'strComputer="tower" '@@@@@@@@@@@@@@@@@@@@@@@@@@@@@remote WMI@@@@@@@
strComputer = "."

Set objShell = CreateObject("WScript.Shell")
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" _
& strComputer & "\root\cimv2")

folder01 = "c:\bootdrv\alohaqs" 'change this for server
folder02 = "\\tower" 'remote WMI

ReadRmtFolder folder01,arrFolders

' ~~~~~~~~~~ this section for remote WMI @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
'For y=0 To UBound(arrFolders)
' ReDim Preserve rmtFile(y)
' temp = objFSO.BuildPath(arrFolders(y),"\ftp.ucf")
' rmtFile(y) = folder02 & Replace(temp,"c:","")
'Next
' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@@@@@@@@@@@@@@@@

' ~~~~~~~~~~ this section to run locally only
For y=0 To UBound(arrFolders)
ReDim Preserve rmtFile(y)
temp = objFSO.BuildPath(arrFolders(y),"\ftp.ucf")
rmtFile(y) = temp
Next
' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

For y=0 To UBound(rmtFile)
MsgBox rmtFile(y)
If objFSO.FileExists(rmtFile(y)) Then
readEntireFile(rmtFile(y))
Else
MsgBox "no file there!",0,rmtFile(y)
End If
Next

quitscript



'******************************************************************************
Function readRmtFolder(path,arr)

Dim x,y,colSubfolders,objFolder
x=0

Set colSubfolders = objWMIService.ExecQuery _
("ASSOCIATORS OF {Win32_Directory.Name='" _
& path & "'} " _
& "WHERE AssocClass = Win32_Subdirectory " _
& "ResultRole = PartComponent")

For Each objFolder in colSubfolders
ReDim Preserve arr(x)
arr(x) = objFolder.Name
x=x+1
Next

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

'******************************************************************************
Function readEntireFile(path)

Const ForReading = 1
Dim myFile,x,arrLines(),t,z
Set myFile = objFSO.OpenTextFile(path,ForReading,False)
x=0

If myFile.AtEndOfStream = True Then
MsgBox "Nothing in this file!",0,path
Exit Function
End If

Do While myFile.AtEndOfStream <> True
t = myFile.ReadLine
ReDim Preserve arrLines(x)
arrLines(x) = t
x=x+1
Loop

myFile.Close

writeNewTextToFile path,arrLines

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

'******************************************************************************
Function writeNewTextToFile(path,arr)

Const ForWriting = 2
Dim myFile,x
Set myFile = objFSO.OpenTextFile(path,ForWriting,False)
x=0

Do
If (InStr(1,arr(x),"user blank1 blank2",1)) Then
MsgBox "I'm here!"
myFile.WriteLine "user BLANK1 BLANK2"
Else
myFile.WriteLine arr(x)
End If
x=x+1
Loop Until x=(UBound(arr)+1)

myFile.Close

End Function
'*******************************************************************|
'******************************************************************************
Function quoteMe(x)

quoteMe = Chr(34) & x & Chr(34)

End Function
'*******************************************************************|
'******************************************************************************
Function singleMe(x)

singleMe = Chr(39) & x & Chr(39)

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

dbbl = vbCr & vbCr

End Function
'*******************************************************************|
'******************************************************************************
Sub quitscript

MsgBox "Quitting Now"
Wscript.Quit

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

No comments:

Post a Comment