Tom's Guide | Tom's Hardware | Tom's Games
 |
 |
 |
Hi,
I don't know much about VB scripting but it seems to be one of solutions for my problem.
I have found one script and tried to modify it for my needs but no luck so far. In network I want to copy all the . xls files from one folder which has subfolders to another folder so that this one has same subfolder structure as the source one. In addition I want files to be compared by date so I dont have to overwrite the old ones every time.
So...here;s the code:Option Explicit
Dim WshShell
Dim fso
Dim srcPath
Dim tgtPath
Dim endPath
Dim startPath
On Error Resume Next
Set WshShell = WScript.CreateObject("Wscript.Shell")
Set fso = WScript.CreateObject("Scripting.FilesystemObject")
srcPath = "\\SOURCE FOLDER\*.xls"
endPath=WshShell.ExpandEnvironmentStrings("%PATH:~45,15%")
startPath = "\\PATH FOLDER\"
tgtPath = startPath & endPath
If Not fso.FileExists(tgtPath) Then
fso.CopyFile srcPath, tgtPath, True
ElseIf fso.FileExists(srcPath) Then
ReplaceIfNewer srcPath, tgtPath
End IfSub ReplaceIfNewer(strSourceFile, strTargetFile)
Const OVERWRITE_EXISTING = True
Dim objFso
Dim objTargetFile
Dim dtmTargetDate
Dim objSourceFile
Dim dtmSourceDate
Set objFso = WScript.CreateObject("Scripting.FileSystemObject")
Set objTargetFile = objFso.GetFile(strTargetFile)
dtmTargetDate = objTargetFile.DateLastModified
Set objSourceFile = objFso.GetFile(strSourceFile)
dtmSourceDate = objSourceFile.DateLastModified
If (dtmTargetDate < dtmSourceDate) Then
objFso.CopyFile objSourceFile.Path, objTargetFile.Path,OVERWRITE_EXISTING
End If
Set objFso = Nothing
End Sub
I cannot seem to get how to set variable tgtPath to have the value of source folder.If anybody has any idea...thnx
I rewrote it:
Option Explicit
Dim fileCount
Const fromDir = "SourceHere"
Const toDir = "DestinationHere"
fileCount = CopyXLS(CreateObject("Scripting.FilesystemObject"), fromDir, toDir)
On Error Resume Next
WScript.StdOut.WriteLine "Copied " & fileCount & " files."
WScript.Quit fileCount
'oFSO (object) - FileSystemObject to use
'sStart (string) = Source directory
'sEnd (string) - Destination directory
Function CopyXLS(oFSO, sStart, sEnd) 'As Integer
Dim d, f, i, ext
If Right(sEnd, 1) <> "\" Then _
sEnd = sEnd & "\"
If Not oFSO.FolderExists(sEnd) Then _
oFSO.CreateFolder sEnd
With oFSO.GetFolder(sStart)
For Each f In .Files
ext = oFSO.GetExtensionName(f)
If Len(ext) And InStr(1, "xls", ext, 1) And _
ShouldCopy(oFSO, sEnd & f.Name, f.DateLastModified) Then
f.Copy sEnd
i = i + 1
End If
Next 'f
For Each d In .SubFolders
i = i + CopyXLS(oFSO, d, sEnd & d.Name & "\")
Next 'd
End With
CopyXLS = i
End Function
'oFSO (object) - FileSystemObject to use
'sFile (string) - File (w/ path) to check
'dCutoff (date) - Date to compare to file's date.
Function ShouldCopy(oFSO, sFile, dCutoff) 'As Boolean
With oFSO
If Not .FileExists(sFile) Then
ShouldCopy = True
Exit Function
End If
ShouldCopy = .GetFile(sFile).DateLastModified < dCutoff
End With
End Function
0 
 |
 |
 |
This post is quite old and has been locked from receiving new replies. Please create a new posting instead.
| Ads by Google |
