File and Folder copy .log VBscript 1

TheNewOne · Mar 14, 2005

Hi forum. I need a script that copyes a set of files from server to network share. I would like to audit which folders(content of that folders) and files were copyed. I would like to make a log file in which are loged all files & folders & content of that folders. Script that i made so far autit only files, but not folders. It looks like this:

for each oFile in oFolder.files
oFSO.copyfile oFile.path, trgFolder & "\" & oFile.name, true
oTS.writeline now & "_" & oFile.path & "_" & oFile.DateLastModified
next

Can someone give me direction or some adwice how to make this. THX and sorry for my bad English.

SaMaLaKo · Mar 14, 2005

from the folderobject oFolder:
- oFolder.path
- oFolder.subfolders
- oFolder.DateLastModified

You can do it exactly the same way you do it with the files...

Please tell me if I'm wrong I like to learn from my mistakes...
_____________________________________
Feed a man a fish and feed him for a day.
Teach a man to fish and feed him for a lifetime...

TheNewOne · Mar 15, 2005

THX for your reply K0b3. Can you give me advice more?? Think I cant do this with my own brain ability.

Ther's my whole script:

Set oFSO = CreateObject("Scripting.FileSystemObject")
Set Nw = CreateObject("WScript.Network")

srcFolder = "d:\sharename"
trgFolder = "x:"

set oFolder = oFSO.GetFolder(srcfolder)
On Error Resume Next
Err.clear
iReturn = Nw.MapNetworkDrive("X:","\\server\share", , "domain\user" , "password")
If Err.Number = 0 Then
oTS.writeline (time & " " & "Mapping sucessefull.")
for each oFile in oFolder.files
oFSO.copyfile oFile.path, trgFolder & "\" & oFile.name, true
oTS.writeline now & "_" & oFile.path & "_" & oFile.DateLastModified
next
Else If Err.Number = -2147023570 Then
oTS.writeline (time & " " & "Mapping unsucessefull!!")
Else
oTS.writeline (time & "ERROR on DTRCFPS01: " & Err.Number & " - " & Err.Description)
End If
End if
On error goto 0

PHV · Mar 15, 2005

Do a search in this forum for recursive folder

Hope This Helps, PH.
Want to get great answers to your Tek-Tips questions? Have a look at FAQ219-2884 or FAQ222-2244

SaMaLaKo · Mar 15, 2005

I think this is what you are looking for:

Code:

Option Explicit
Dim srcFolder, trgFolder, TSFile
Dim oFSO, oTS, oNw

TSFile = "?"
srcFolder = "d:\sharename"
trgFolder = "x:"

Set oFSO = CreateObject("scripting.FileSystemObject")
Set oTS = oFSO.OpenTextFile (TSFile, 8,True)
Set oNw = CreateObject("WScript.Network")
On Error Resume Next
Err.clear
oNw.MapNetworkDrive("X:","\\server\share", , "domain\user" , "password")  
If Err.Number = 0 Then
	oTS.writeline (time & " " & "Mapping sucessefull.")
	CopyFilesAndFolders srcFolder, trgFolder
Else If Err.Number = -2147023570 Then
	oTS.writeline (time & " " & "Mapping unsucessefull!!")
Else
	oTS.writeline (time & "ERROR on DTRCFPS01: " & Err.Number & " - " & Err.Description)
End If
On error goto 0

Sub CopyFilesAndFolders (ByVal strSource, ByVal strDestination)
	Dim ObjFSO, ObjFolder, ObjSubFolder, ObjFile, files
	Dim TargetPath
	Set ObjFSO = CreateObject("scripting.filesystemobject")
	'connecting to the folder where is going to be searched
	Set ObjFolder = ObjFSO.GetFolder(strSource)
	TargetPath = Replace (objFolder.path& "\", strSource, strDestination,1,-1,vbTextCompare)
	ObjFSO.CopyFolder ObjFolder.Path, TargetPath, True
 	oTS.writeline now & "_" & objFolder.path & "_"  & objFolder.DateLastModified
	Err.clear
	On Error Resume Next
	'Check all files in a folder
	For Each objFile In ObjFolder.files
		If Err.Number <> 0 Then Exit For 'If no permission or no files in folder
		On Error goto 0
		'DO STUFF HERE
		objFSO.copyfile objFile.path, TargetPath & ObjFolder.Name & "\" & objFile.name, True
		oTS.writeline now & "_" & objFile.path & "_"  & objFile.DateLastModified
	Next
	'Recurse through all of the subfolders
	On Error Resume Next
	Err.clear
	For Each objSubFolder In ObjFolder.subFolders 
		If Err.Number <> 0 Then Exit For 'If no permission or no subfolder in folder
		On Error goto 0
		'For each found subfolder there will be searched for files
		CopyFilesAndFolders ObjSubFolder.Path & "\", TargetPath & ObjFolder.Name & "\" & ObjSubFolder.name & "\"
	Next
	Set ObjFile = Nothing
	Set ObjSubFolder = Nothing
	Set ObjFolder = Nothing
	Set ObjFSO = Nothing
End Sub

Go trough it and change what needs to change.
Hope you understand how it works...

P.S. don't say you gave the complete code if you didn't. It will only be in you benefit if you put the complete code...

Please tell me if I'm wrong I like to learn from my mistakes...
_____________________________________
Feed a man a fish and feed him for a day.
Teach a man to fish and feed him for a lifetime...

TheNewOne · Mar 17, 2005

Mega K0b3

You rock. Only one question more. I would like to copy whole content of srcFolder = "d:\sharename", so if I put srcFolder = "d:\sharename\" , nothing write to .log file. Do you maybe know where is problem??? THX for all your work again and star for you.

P.S. I didn't put all code here cause I thaught that mapping, for "X:" drive was unimportant. Sorry

SaMaLaKo · Mar 17, 2005

Can you show me the code in line 4
'TSFile = "?"' What did you fill in here?
It should be the path of the logfile
something like:
TSFile = "C:\copylog.log"

TheNewOne · Mar 20, 2005

Sorry K0b3, I was away from my office. Here is my whole script:

option Explicit
Dim srcFolder, trgFolder, TSFile
Dim oFSO, oTS, oNw
Dim iReturn
Dim oDrives, i

TSFile = "copylog" & "_" & date & ".log"
srcFolder = "d:\apl\"
trgFolder = "x:"

Set oFSO = CreateObject("scripting.FileSystemObject")
Set oTS = oFSO.OpenTextFile ("c:\" & TSFile, 8,True)
oTS.writeline ("VB Sctipt started on" & " " & date & " " & "at" & " " & time)
Set oNw = CreateObject("WScript.Network")

Set oDrives = oNw.EnumNetworkDrives
For i = 0 to oDrives.Count - 1 Step 2
If oDrives.Item(i) = "X:" Then
oNw.RemoveNetworkDrive oDrives.Item(i), true
wscript.sleep 3000
End If
Next

On Error Resume Next
Err.clear
iReturn = oNw.MapNetworkDrive("X:","\\server\share", , "domain\administrator" , "password")
If Err.Number = 0 Then
oTS.writeline (time & " " & "Mapping O.K.")
CopyFilesAndFolders srcFolder, trgFolder
Else If Err.Number = -2147023570 Then
oTS.writeline (time & " " & "Mapping unsuccesfull!!")
Else
oTS.writeline (time & "ERROR on SERVER: " & Err.Number & " - " & Err.Description)
End If
On error goto 0

Sub CopyFilesAndFolders (ByVal strSource, ByVal strDestination)
Dim ObjFSO, ObjFolder, ObjSubFolder, ObjFile, files
Dim TargetPath
Set ObjFSO = CreateObject("scripting.filesystemobject")
'connecting to the folder where is going to be searched
Set ObjFolder = ObjFSO.GetFolder(strSource)
TargetPath = Replace (objFolder.path& "\", strSource, strDestination,1,-1,vbTextCompare)
ObjFSO.CopyFolder ObjFolder.Path, TargetPath, True
oTS.writeline now & "_" & objFolder.path & "_" & objFolder.DateLastModified
Err.clear
On Error Resume Next
'Check all files in a folder
For Each objFile In ObjFolder.files
If Err.Number <> 0 Then Exit For 'If no permission or no files in folder
On Error goto 0
'DO STUFF HERE
objFSO.copyfile objFile.path, TargetPath & ObjFolder.Name & "\" & objFile.name, True
oTS.writeline now & "_" & objFile.path & "_" & objFile.DateLastModified
Next
'Recurse through all of the subfolders
On Error Resume Next
Err.clear
For Each objSubFolder In ObjFolder.subFolders
If Err.Number <> 0 Then Exit For 'If no permission or no subfolder in folder
On Error goto 0
'For each found subfolder there will be searched for files
CopyFilesAndFolders ObjSubFolder.Path & "\", TargetPath & ObjFolder.Name & "\" & ObjSubFolder.name '& "\"
oTS.writeline ("VB Sctipt ended on" & " " & date & " " & "at" & " " & time)
Next
Set ObjFile = Nothing
Set ObjSubFolder = Nothing
Set ObjFolder = Nothing
Set ObjFSO = Nothing
End Sub
End If

Problem is that I want to copy content of srcFolder, so If I put srcFplder= "d:\apl\" nothing writes to .log file, if there is srcFolder = "d:\apl" script works OK, but script copyes whole "apl" folder, I want copy content of that folder.

SaMaLaKo · Mar 20, 2005

changed the code a bit to your needs...

Also some points of attention to you:
[1]When you set an object (filesystem, Network,...) don't forget to 'release' the variable when you don't need the object anymore (Set ... = Nothing) this will free up the variables resources.
[2]A filename cannot contain al characters (ex: '/') so your logfiles filename will give some errors...

Code:

Option Explicit
Dim srcFolder, trgFolder, TSFile
Dim oFSO, oTS, oNw
Dim iReturn
Dim oDrives, i

TSFile = "C:\copylog_" & year(now) & month(now) & day(now) & ".log"
srcFolder = "d:\apl\"
trgFolder = "x:"

Set oFSO = CreateObject("Scripting.FileSystemObject")
Set oTS = oFSO.OpenTextFile (TSFile, 8,True)
oTS.writeline ("VBScript started on" & " " & date & " " & "at" & " " & time)
Set oNw = CreateObject("WScript.Network")
Set oDrives = oNw.EnumNetworkDrives
For i = 0 to oDrives.Count - 1 Step 2
    If  oDrives.Item(i) = "X:" Then
        oNw.RemoveNetworkDrive oDrives.Item(i), true
        wscript.sleep 3000        
    End If
Next

On Error Resume Next
Err.clear
iReturn = Nw.MapNetworkDrive("X:","\\server\share", False, "domain\user", "password")  
If Err.Number = 0 Then
	oTS.writeline (time & " " & "Mapping sucessefull.")
	CopyFilesAndFolders srcFolder, trgFolder
ElseIf Err.Number = -2147023570 Then
	oTS.writeline (time & " " & "Mapping unsucessefull!!")
Else
	oTS.writeline (time & "ERROR on DTRCFPS01: " & Err.Number & " - " & Err.Description)
End If
On error goto 0
oTS.Close
Set oTS = Nothing
Set oFSO = Nothing
Set oDrives = Nothing
Set oNw = Nothing

Sub CopyFilesAndFolders (ByVal strSource, ByVal strDestination)
	Dim ObjFSO, ObjFolder, ObjSubFolder, ObjFile, files
	Dim TargetPath
	Set ObjFSO = CreateObject("scripting.filesystemobject")
	'connecting to the folder where is going to be searched
	Set ObjFolder = ObjFSO.GetFolder(strSource)
	If not Right(strSource,1) = "\" Then strSource = StrSource & "\"
	TargetPath = Replace (objFolder.path & "\", strSource, strDestination, 1, -1, vbTextCompare)
	Err.clear
	On Error Resume Next
	'Check all files in a folder
	For Each objFile In ObjFolder.files
		If Err.Number <> 0 Then Exit For 'If no permission or no files in folder
		On Error goto 0
		'DO STUFF HERE
		objFSO.copyfile objFile.path, TargetPath & objFile.name, True
        oTS.writeline now & "_" & objFile.path & "_"  & objFile.DateLastModified
	Next
	'Recurse through all of the subfolders
	On Error Resume Next
	Err.clear
	For Each objSubFolder In ObjFolder.subFolders 
		If Err.Number <> 0 Then Exit For 'If no permission or no subfolder in folder
		On Error goto 0
		'For each found subfolder there will be searched for files
		ObjFSO.CreateFolder TargetPath & ObjSubFolder.name & "\"
		CopyFilesAndFolders ObjSubFolder.Path & "\", TargetPath & ObjSubFolder.name & "\"
	Next
	Set ObjFile = Nothing
	Set ObjSubFolder = Nothing
	Set ObjFolder = Nothing
	Set ObjFSO = Nothing
End Sub

Please tell me if I'm wrong I like to learn from my mistakes...
_____________________________________
Feed a man a fish and feed him for a day.
Teach a man to fish and feed him for a lifetime...

TheNewOne · Mar 21, 2005

Excelent K0b3. Script works perfect. THX for all your help, and another star for your excelent solution. Rock on!!

Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

File and Folder copy .log VBscript 1

TheNewOne

Technical User

SaMaLaKo

Technical User

TheNewOne

Technical User

PHV

MIS

SaMaLaKo

Technical User

TheNewOne

Technical User

SaMaLaKo

Technical User

TheNewOne

Technical User

SaMaLaKo

Technical User

TheNewOne

Technical User

Similar threads

Part and Inventory Search

Sponsor