Moving Files and Folders to a new location.

Microsoft Visual basic professional ed 6...
August 26, 2010 at 11:16:53
Specs: Windows XP
Please help, I have found alot of posts on this type of request but none matched my need exactly. I am a rookie to say the least when it comes to VB scripting.
I need to move files that may be in subfolders on the local PC C:\CCQM to a network share called \\harvest\ccqm$ with the folder structure intact.
The following script:
1. Creates a folder structure on the network share using the PC's name as the root Folder name
2. Moves files from the ROOT of c:\ccqm but not if they are in a sub folder to the network share
3. Writes Stats

*I need to move the files and folders to the new location using VB scripting.

Option Explicit
Dim ScriptFile,SMSPath,Command,SysDir,oFSO,WshShell,oNetwork,File
Dim ASCIIFormat,ToRead,ToWrite,ToAppend,nl,WriteStats,CreateTextFile,fileone,filetwo
Dim Computer,User,WriteSemaphore,CCQMDir,DestinationPath,CCQMFolder,CCQMFiles
Dim CCQMFolderFlagFile,CCQMServer,CurrentYear,JulianDate,CCQMCount,SMSStatDir

Set WshShell = Wscript.CreateObject("Wscript.Shell")
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set oNetwork = Wscript.CreateObject("Wscript.Network")

ScriptFile = oFSO.GetFile("CallLogHarvest.vbs")
SMSPath = oFSO.GetParentFolderName(ScriptFile)
SMSStatDir = "\\TESTnts02\smsstat$\CallLogHarvest"
SysDir = "c:\windows\system32"
CCQMDir = "C:\CCQM\"
Command = WshShell.ExpandEnvironmentStrings("%Comspec%")
ASCIIFormat = 0
ToRead = 1
ToWrite = 2
ToAppend = 8
nl = Vbcrlf
Computer = oNetwork.ComputerName
User = oNetwork.UserName
Set CCQMFolder = oFSO.GetFolder(CCQMDir)
Set CCQMFiles = CCQMFolder.files
CCQMCount = CCQMFiles.count

' the directory structure is as follows:
' \\TESTNTS04R\CCQM$\{machine name}\{Year}\{Julian Day}

CCQMFolderFlagFile = "CCQMsHere.txt"
CCQMServer = "\\TESTNTS04\CCQM$\"
CurrentYear = Year(now)
JulianDate = DatePart("y", now)
DestinationPath = CCQMServer&Computer&"\"&CurrentYear&"\"&JulianDate

If CCQMCount > 0 Then ' if CCQM directory contents is greater than zero, then run script

If oFSO.FileExists(SMSStatDir&"\_"&Computer&"_Stats.txt") = False Then
CreateTextFile = True
CreateTextFile = False
End If

Set WriteStats = oFSO.OpenTextFile(SMSStatDir&"\_"&Computer&"_Stats.txt", ToAppend, CreateTextFile, ASCIIFormat)
WriteStats.Write("Date: "&Date&nl)
WriteStats.Write("Time: "&Time&nl)
WriteStats.Write("Computer Name: "&Computer&nl)
WriteStats.Write("Username: "&User&nl&nl)
WriteStats.Write("CCQM file move progress:"&nl&nl)
WriteStats.Write(" "&CCQMCount&" files found in CCQM directory."&nl) ' report number of files moved in stats file

' On Error Resume next

' verify that destination path exists. If not create destination path

If oFSO.FolderExists(DestinationPath) = False Then
' If oFSO.FileExists(CCQMServer&CCQMFolderFlagFile) = False Then
' WriteStats.Write("***ERROR!*** Unable to contact primary server!"&nl&nl)
' WScript.Quit 0
' End If
If oFSO.FolderExists(CCQMServer&Computer) = False Then
End If
If oFSO.FolderExists(CCQMServer&Computer&"\"&CurrentYear) = False Then
End If
If oFSO.FolderExists(CCQMServer&Computer&"\"&CurrentYear&"\"&JulianDate) = False Then
End If
End if

' move files from to destination path

For Each File In CCQMFiles
If oFSO.FileExists(DestinationPath&"\"&File.Name) = False Then
oFSO.MoveFile CCQMDir&"\"&File.Name, DestinationPath&"\"&File.Name
WriteStats.Write(" ***WARNING!*** CCQM file "&File.Name&" already exists!"&nl)
End If

' verify that the file count in CCQM is lower than or equal to that before script was run

Set CCQMFolder = oFSO.GetFolder(CCQMDir)
Set CCQMFiles = CCQMFolder.files
if CCQMCount > CCQMFiles.Count Then
WriteStats.Write(" "& CCQMCount - CCQMFiles.Count &" CCQM file(s) were moved."&nl)
WriteStats.Write(" No CCQM files were moved!"&nl)
end If

End If

Wscript.Quit 0

See More: Moving Files and Folders to a new location.

Report •

August 26, 2010 at 18:05:51
Good lord, 100 lines and no horizontal whitespace.
Option Explicit
WScript.Quit Main

Function Main()
  Dim com, usr, dest, log 'As String
  Dim FSO 'As FileSystemObject

  Set FSO = CreateObject("Scripting.FileSystemObject")
  With CreateObject("WScript.Network")
    com = .ComputerName
    usr = .UserName
  End With
  ' the directory structure is as follows:
  ' \\TESTNTS04R\CCQM$\{machine name}\{Year}\{Julian Day}
  dest = "\\TESTNTS04\CCQM$\" & com & "\" & Year(Now) & "\" & DatePart("y", Now) & "\"
  'Note: I'm not bothering to do logging. That can be an exercise for the reader
  'I am creating the log file, though.
  Set log = FSO.OpenTextFile("\\TESTnts02\smsstat$\CallLogHarvest\_" & com & "_Stats.txt", 8, True)
  MakeDir FSO, dest
  FSO.CopyFolder "C:\CCQM\*", dest
  FSO.CopyFile   "C:\CCQM\*", dest
  Main = 0
End Function

Sub MakeDir(FSO, dirPath)
  If dirPath = "" Then Exit Sub
  MakeDir FSO, FSO.GetParentFolderName(dirPath)
  If Not FSO.FolderExists(dirPath) Then _
    FSO.CreateFolder dirPath
End Sub

Report •

September 1, 2010 at 12:58:04
Thanks a million!!!
I am sorry for the slow response, I have been on vacation.
You get 999 cool points.

I had an error on line 24, which I Rem'd out because the CopyFolder copy works fine.

'FSO.CopyFile "C:\CCQM\*", dest

The log file is not being created but I can live with that totally and maybe i'll add the old syntax for that.

**Everyon please continue to post and help others, this has saved me... about 4 weeks of frustration trying to figure VB out and take care of my daily duties or projects.


Report •

Related Solutions

Ask Question