Link to home
Create AccountLog in
Avatar of bsharath
bsharathFlag for India

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
'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

Open in new window

ASKER CERTIFIED SOLUTION
Avatar of zoofan
zoofan
Flag of United States of America image

Link to home
membership
Create a free account to see this answer
Signing up is free and takes 30 seconds. No credit card required.
See answer
Avatar of bsharath

ASKER

Thanks Zoofan worked fine... :-)
your welcome


zf