bsharath
asked on
I have this script from zoofan that creates a folder and shares it. Works fine but need to create a txt file with some data within it.
Hi,
I have this script from zoofan that creates a folder and shares it. Works fine but need to create a txt file with some data within it.
Within this script i want a txt file as " Read this.txt" created with say 2 lines of data in it.
Regards
Sharath
I have this script from zoofan that creates a folder and shares it. Works fine but need to create a txt file with some data within it.
Within this script i want a txt file as " Read this.txt" created with say 2 lines of data in it.
Regards
Sharath
'START copy createdatashare.vbs
'===============================================================================================
' VBScript Source File
' Name: CreateDataShare.vbs
' Purpose: Check/create 'data' folder/share on target pc's
' Author: Riley C. aka: ZooFan(http://www.experts-exchange.com))
' Revision : 1.6
' Date: 8/3/2008
' EE question: http://www.experts-exchange.com/Programming/Languages/Q_23613267.html#a22146532
'***
'A hat tip to RobSampson(EE) on the concept/idea of dragging the input file onto the
'script and using as a CL argument. Very nice, clean method!!!
'***
' This file may be redistributed/used in whole or in part but must include this header.
'===============================================================================================
Option Explicit
'Constants
Const ForReading = 1, ForWriting = 2, ForAppending = 8
Const TristateUseDefault = -2, TristateTrue = -1, TristateFalse = 0
'Objects
Dim objFso
Dim objOutputLogFile
'Strings
Dim strInputFileName
Dim strReadInputFileResult
Dim strLogFileName
Dim strLogHeaderText
Dim strLogLineData
Dim strDataLine
Dim strErrorNotice
Dim strWorkingDir
Dim strLogPath
Dim strDriveUsed
'Integers
Dim intDataLoop
'Arrays
Dim arrInputFileData()
'Test that the user passed one argument
If Wscript.Arguments.Count <> 1 Then
MsgBox "Please drag a file onto this script to run it," & VbCrLf & _
"or from a command line specify the the Full\Path\To\The\filename.txt",vbOKOnly,"Create Data Shares."
WScript.Quit(0)
Else
'Test that the argument passed was a valid file we can open
strInputFileName = WScript.Arguments(0)
Set objFso = CreateObject("Scripting.FileSystemObject")
If Not objFso.FileExists(strInputFileName) Then
MsgBox "Error locating the file you specified!" & VbCrLf & VbCrLf & _
"Please drag a file onto this script to run it," & VbCrLf & _
"or from a command line specify the the Full\Path\To\The\filename.txt",vbOKOnly,"Create Data Shares."
WScript.Quit(0)
Else
'Tests passed, argument is a vaild file, process it.
strReadInputFileResult = readFileToArray(strInputFileName,arrInputFileData)
If strReadInputFileResult <> "completed" Then
MsgBox strInputFileName & VbCrLf & strReadInputFileResult,vbOKOnly,"Create Data Shares."
WScript.Quit(0)
Else
'Create the log file and add the header line
Set strWorkingDir = objFso.GetFile(strInputFileName)
strLogPath = strWorkingDir.ParentFolder
strLogHeaderText = "Date,Time,Computer Name,Completed/Error,Drive Used"
strLogFileName = createLogFile(strLogHeaderText,strLogPath)
If Left(strLogFileName,5) = "Error" Then
MsgBox strLogFileName,vbOKOnly,"Create Data Shares."
WScript.Quit(0)
Else
'open log file
Set objOutputLogFile = objFso.OpenTextFile(strLogFileName,ForAppending)
'loop thru each pc and do our work
For Each strDataLine In arrInputFileData
'Check to make sure we can connect to the remote machine
strErrorNotice = IsPCconnected(strDataLine)
If strErrorNotice = "Completed" Then
'Check that the remote d: drive letter exists and that it is a physical/logical drive(ie:not removable/optical/network map) otherwise use c:
strDriveUsed = CheckRemoteDrive(strDataLine)
'Check to see if there is already a share with the same name on remote pc
strErrorNotice = CheckRemoteShare(strDataLine)
If strErrorNotice = "Completed" Then
'Check to see if the folder exists already if not create it as everything has passed
strErrorNotice = CheckCreateRemoteFolder(strDataLine,strDriveUsed)
If strErrorNotice = "Completed" Then
'Create the share
strErrorNotice = CreateRemoteShare(strDataLine,strDriveUsed)
End If
End If
End If
objOutputLogFile.WriteLine FormatDateTime(Now(),vbshortdate) & "," & FormatDateTime(Now(),vbLongtime) & "," & strDataLine & "," & strErrorNotice & "," & strDriveUsed
Next
'close log file
objOutputLogFile.Close
Set objOutputLogFile = Nothing
End If
Set strWorkingDir = Nothing
End If
End If
Set objFso = Nothing
MsgBox "Your file has been processed, and the results stored in:" & VbCrLf & strLogFileName,vbOKOnly,"Create Data Shares."
End If
WScript.Quit(0)
Private Function createLogFile(strHeaderText,strLogFilePath)
Err.Clear
On Error Resume Next
Dim objFunctFso
Dim objFunctWshShell
Dim objFunctOutputFile
Dim strResultsDate
Dim strResultsTime
Dim strResultsFile
Set objFunctFso = CreateObject("Scripting.FileSystemObject")
Set objFunctWshShell = WScript.CreateObject("WScript.Shell")
strResultsDate = Replace(FormatDateTime(date(),vbshortdate),"/","-")
strResultsTime = Replace(Replace(FormatDateTime(now(),vbLongtime),":","-")," ","")
strResultsFile = strLogFilePath & "\CreateDataShares_" & strResultsTime & "_" & strResultsDate & ".csv"
Set objFunctOutputFile = objFunctFso.CreateTextFile(strResultsFile)
objFunctOutputFile.WriteLine strHeaderText
objFunctOutputFile.Close
Set objFunctOutputFile = Nothing
Set objFunctWshShell = Nothing
Set objFunctFso = Nothing
If Err.Number <> 0 Then
createLogFile = "Error occurred while creating the log file." & VbCrLf & Err.Description
Else
createLogFile = strResultsFile
End If
On Error GoTo 0
End Function
Private Function readFileToArray(strTxtFile, arrname())
Err.Clear
On Error Resume Next
Dim intFuncLines
Dim objFuncTxtLines
Dim objFuncReadFile
Dim objFuncFso
Set objFuncFso = CreateObject("Scripting.FileSystemObject")
Set objFuncTxtLines = objFuncFso.GetFile(strTxtFile)
Set objFuncReadFile = objFuncTxtLines.OpenAsTextStream(ForReading, TristateUseDefault)
Do Until objFuncReadFile.AtEndOfStream
ReDim Preserve arrname(intFuncLines)
arrname(intFuncLines) = objFuncReadFile.ReadLine
intFuncLines = intFuncLines + 1
Loop
objFuncReadFile.Close
Set objFuncReadFile = Nothing
Set objFuncTxtLines = Nothing
Set objFuncFso = Nothing
If Err.Number <> 0 Then
readFileToArray = "Error reading file: " & strTxtFile & VbCrLf & "Description: " & Err.Description
Else
readFileToArray = "completed"
End If
On Error GoTo 0
End Function
Function IsPCconnected(strRemotePC)
Err.Clear
On Error Resume Next
Dim Testme
Dim strTestConn
Set Testme = GetObject("winmgmts://" & strRemotePC & "/root/cimv2")
Set strTestConn = GetObject("winmgmts://" & strRemotePC & "/root/default:StdRegProv")
Set Testme = Nothing
Set strTestConn = Nothing
If Err.Number <> 0 Then
IsPCconnected = Err.Description
Else
IsPCconnected = "Completed"
End If
On Error GoTo 0
End Function
Private Function CheckCreateRemoteFolder(strRemoteComputer,strRemoteDrive)
Err.Clear
On Error Resume Next
Dim objFuncFso
Set objFuncFso=CreateObject("Scripting.FileSystemObject")
If Not objFuncFso.FolderExists("\\" & strRemoteComputer & "\" & strRemoteDrive & "$\data") Then
objFuncFso.CreateFolder("\\" & strRemoteComputer & "\" & strRemoteDrive & "$\data")
End If
Set objFuncFso = Nothing
If Err.Number <> 0 Then
CheckCreateRemoteFolder = Err.Description
Else
CheckCreateRemoteFolder = "Completed"
End If
On Error GoTo 0
End Function
Private Function CheckRemoteShare(strRemoteComputer)
Dim objFuncWMIService
Dim colFuncShares
Set objFuncWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}\\" & strRemoteComputer & "\root\cimv2")
Set colFuncShares = objFuncWMIService.ExecQuery ("Select * from Win32_Share where name = 'data'")
If colFuncShares.count = 0 Then
CheckRemoteShare = "Completed"
Else
CheckRemoteShare = "Share Already Exists"
End If
Set objFuncWMIService = Nothing
Set colFuncShares = Nothing
End Function
Private Function CheckRemoteDrive(strRemoteComputer)
Dim objFuncWMIService
Dim colFuncVolume
Dim strLname
Set objFuncWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}\\" & strRemoteComputer & "\root\cimv2")
Set colFuncVolume = objFuncWMIService.ExecQuery ("Select * from Win32_LogicalDisk where DeviceID = 'd:' And DriveType = '3'")
If colFuncVolume.count = 1 Then
CheckRemoteDrive = "D"
Else
CheckRemoteDrive = "C"
End If
Set objFuncWMIService = Nothing
Set colFuncVolume = Nothing
End Function
Private Function CreateRemoteShare(strRemoteComputer,strRemoteDrive)
Err.Clear
On Error Resume Next
Dim objFunctWMIService
Dim objFuncShare
Dim objShareProperties
Dim strFullLocalPath
strFullLocalPath = strRemoteDrive & ":\data"
Set objFunctWMIService =GetObject("winmgmts:{impersonationLevel=impersonate}\\" & strRemoteComputer & "\root\cimv2")
Set objFuncShare = objFunctWMIService.Get("Win32_Share")
Set objShareProperties = objFuncShare.Methods_("Create").InParameters.SpawnInstance_()
objShareProperties.Properties_.Item("Path") = strFullLocalPath
objShareProperties.Properties_.Item("Name") = "Data"
objShareProperties.Properties_.Item("Description") = "Copy your data here"
objShareProperties.Properties_.Item("Type") = 0
objFuncShare.ExecMethod_ "Create", objShareProperties
Set objFunctWMIService = Nothing
Set objFuncShare = Nothing
Set objShareProperties = Nothing
If Err.Number <> 0 Then
CreateRemoteShare = Err.Description
Else
CreateRemoteShare = "Completed"
End If
On Error GoTo 0
End Function
'END copy createdatashare.vbs
ASKER CERTIFIED SOLUTION
membership
Create a free account to see this answer
Signing up is free and takes 30 seconds. No credit card required.
your welcome
zf
zf
ASKER