VB Script document manager

[Moonlighting2]

I have written this script to manage documents between a local computer and a server on the network. The code loops through every document within a folder on the C drive and then distributes that files based on both the first 3 letters of the file name (this is equal to one of many folders) and the first 7 digits of the file name (equal to the subfolder) of the parent folder

E.g. If had a document called HELPMEP, it would be stored within the HELP folder and within the HELPMEP sub folder.

Somebody help me quickly please, I am in great need.

Here is my code;

Private Sub ActiveXCtl148_Click()

On Error Resume Next

Dim A
Dim B

Dim strSourceFolder, strDestinationFolder, strFileExtension, strLogFile
strSourceFolder = ("C:\send\")

' trying use A & B values to complete path. see further on
'in code.

strDestinationFolder = "O:\sitefile\" & A & "\" & B & "\Drawings\Proposed or current\"
'strDestinationFolder = Path
'strFileExtension = InputBox("File extension:" & vbCrLf & "Enter the file extension of the files you want to move. This script will avoid all files that do not match this extension.", "Move files - Step 3")
strLogFile = "move_files.log"

' Declare objects.
Dim FSO: Set FSO = CreateObject("Scripting.FileSystemObject")

Const ForReading = 1, ForWriting = 2, ForAppending = 8

' Setup the logging feature.
Dim objLogFile: Set objLogFile = FSO.OpenTextFile(strLogFile, ForWriting, True)

objLogFile.WriteLine "Generated on: " & Date
objLogFile.WriteLine ""

' Check to ensure that the values entered are accurate.
If FSO.FolderExists(strSourceFolder) And FSO.FolderExists(strDestinationFolder) Then
' The folders exist, proceed with copying the files.
Dim objSourceFolder, colFiles, objFile, strChildFolderName, intCounter

Set objSourceFolder = FSO.GetFolder(strSourceFolder)
Set colFiles = objSourceFolder.Files
intCounter = 0

' Run through the files in the source folder.
For Each objFile In colFiles
If Left(file.Name, 3) = strDestinationFolder Then
A = Left(file.Name, 3) ' trying to get value into path
strChildFolderName = Left(objFile.Name, 7)
B = Left(objFile.Name, 7) ' trying to get value into path
If FSO.FolderExists(strDestinationFolder & strChildFolderName) Then

objFile.Copy strDestinationFolder & strChildFolderName & "\", True

If Err Then
objLogFile.WriteLine "File NOT copied (" & Err.Number & ": " & Err.Description & "): " & objFile.Name & " to " & strDestinationFolder & strChildFolderName
Else
intCounter = intCounter + 1
End If
Else
objLogFile.WriteLine "File NOT copied (destination folder does not exist): " & objFile.Name & " to " & strDestinationFolder & strChildFolderName
End If
Else
objLogFile.WriteLine "File IGNORED (incorrect file extension): " & objFile.Name
End If
Next

Set objSourceFolder = Nothing
Set colFiles = Nothing
Else
' Either the source or destination folder does not exist.
MsgBox "Either the source or destination folder does not exist. Please enter valid pathnames."
End If

objLogFile.WriteLine "Files copied: " & intCounter
objLogFile.Close
Set objLogFile = Nothing
Set FSO = Nothing
WScript.Quit

End Sub

 

[Moonlighting2]

It's ok, I sorted it myself.

Private Sub ActiveXCtl148_Click()

On Error Resume Next

Dim strSourceFolder, strDestinationFolder, strFileExtension, strLogFile
strSourceFolder = ("C:\send")
strDestinationFolder = "O:\sitefile\"
strLogFile = "move_files.log"

' Declare objects.
Dim FSO: Set FSO = CreateObject("Scripting.FileSystemObject")

Const ForReading = 1, ForWriting = 2, ForAppending = 8

' Setup the logging feature.
Dim objLogFile: Set objLogFile = FSO.OpenTextFile(strLogFile, ForWriting, True)

objLogFile.WriteLine "Generated on: " & Date
objLogFile.WriteLine ""

' Check to ensure that the values entered are accurate.
If FSO.FolderExists(strSourceFolder) And FSO.FolderExists(strDestinationFolder) Then
' The folders exist, proceed with copying the files.
Dim objSourceFolder, colFiles, objFile, strChildFolderName, intCounter

Set objSourceFolder = FSO.GetFolder(strSourceFolder)
Set colFiles = objSourceFolder.Files
intCounter = 0

' Run through the files in the source folder.
For Each objFile In colFiles
If Left(file.Name, 3) = strDestinationFolder Then
strChildFolderName = Left(objFile.Name, 3) & "\" & Left(objFile.Name, 7) & "\Drawings\Proposed or current\Rollout"
If FSO.FolderExists(strDestinationFolder & strChildFolderName) Then

objFile.Copy strDestinationFolder & strChildFolderName & "\", True

If Err Then
objLogFile.WriteLine "File NOT copied (" & Err.Number & ": " & Err.Description & "): " & objFile.Name & " to " & strDestinationFolder & strChildFolderName
Else
intCounter = intCounter + 1
End If
Else
objLogFile.WriteLine "File NOT copied (destination folder does not exist): " & objFile.Name & " to " & strDestinationFolder & strChildFolderName
End If
Else
objLogFile.WriteLine "File IGNORED (incorrect file extension): " & objFile.Name
End If
Next

Set objSourceFolder = Nothing
Set colFiles = Nothing
Else
' Either the source or destination folder does not exist.
MsgBox "Either the source or destination folder does not exist. Please enter valid pathnames."
End If

objLogFile.WriteLine "Files copied: " & intCounter
objLogFile.Close
Set objLogFile = Nothing
Set FSO = Nothing
WScript.Quit

End Sub

 

[strongm]

(glad to hear you worked it out, but you're basically in the wrong forum ... I think you probably want forum329 in the future)