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