Solved: Manipulating Files on Network Drives

[Anne Troy]

Kenneth Hobs was kind enough to write some code for me. It's commented in the attached file. It creates folders on a network share.

I'd like to expand on that code. I have more specific instructions in the attached Excel file, but the basics are that I'm scanning PDF files relating to our Purchase Orders. We name the scanned files by 4-digit PO number and they get placed on a network "dump" drive. From there, I want the macro to move them to a more permanent location, creating new folders, and renaming files as necessary to accommodate the task.

I cannot tell you how much time this will save me, and how much I will worship the ground you walk on.

I'm reachable by phone if it will help in any way. My number is in the Excel file.

Thanks for having a look!

[Bob Phillips]

The task itself seems trivial, but I am not getting the spec.


P:\Stock Room\
........................101-200\
.........................201-300\
......................................201\
.............................................201.pdf
......................................206\
......................................207\
.............................................207.pdf
.............................................207-1.pdf
.............................................207-2.pdf

and it seems you want to change these to say

Q:\Some Folder\
.........................201-300\
......................................201.pdf
......................................207.pdf
......................................207-1.pdf
......................................207-2.pdf

Is this accurate, or is there more to it?
It seems to me that you have a layout like so

[Anne Troy]

Thanks, darling!

It's like this:

P:\Stock Room\
201.pdf
207.pdf
208.pdf
(tomorrow, it could be
202.pdf
207.pdf
209.pdf


and I want to MOVE them to

S:\Some Folder\
.........................201-300\
......................................201.pdf
......................................202.pdf
......................................207.pdf
......................................207-1.pdf
......................................208.pdf
......................................209.pdf

Let me know if that doesn't make sense.
I would use this macro ongoing...as much as every day, certainly 3 times a week.

[RonMcK]

Ann,

What happens in your source folder when your users scan two or more different documents, at different times during the day, for a given PO? Does the program creating the PDFs append a unique suffix to the 2nd, 3rd, ... nth documents?

Thanks,

[Anne Troy]

I scan the docs--there's really only one person doing it--then almost immediately move them. Also, if the same file name is scanned, the system automatically puts the -1, -2 behind it. But, the system (somehow built into the copier/scanner) may create 207.pdf and 207-1.pdf on the P drive, but there's already a 207.pdf, 207-1.pdf and 207-2.pdf in S:\File Cabinet\Purchase Orders\201-300 folder on the S drive.

I would need this to become 207.pdf, 207-1.pdf, 207-2.pdf, 207-3.pdf, 207-4.pdf and 207-5.pdf. FYI: The numerical order of the suffix is NOT important, but of course it would be nice if they went by the date created.

[RonMcK]

Ann,

So, 201-2.pdf may need to become 201-5.pdf in the target folder. Shouldn't processing them in order created assure that they are in chronological order?

Thanks,

[Anne Troy]

Chronological order would be NICE, but is definitely not necessary given the amount of times these files are later referred to. (I know, I know...don't ask me why each one has to have its own freaking folder...what a waste.)

[RonMcK]

Ann,

Looking at your reply to Bob in #3, above, I understood that POs 201-300 and their "attachments" (additional documents) were being dropped into the '201-300' folder with no separate folders for 201, 202, 203, ... 300. I sense that I misunderstood the requirement.

Is the desired end result:

S:\Some Folder\
.........................201-300\
......................................201.pdf
......................................202.pdf
......................................207.pdf
......................................207-1.pdf
......................................208.pdf
......................................209.pdf

<or>

S:\Some Folder\
.........................201-300\
......................................201\
............................................201.pdf
......................................202\
............................................202.pdf
......................................207\
............................................207.pdf
............................................207-1.pdf
......................................208\
............................................208.pdf
......................................209\
............................................209.pdf

Thanks,

[Bob Phillips]

[vba]

Dim FSO As Object
Const ROOT_SOURCE_FOLDER As String = "C:\test\Anne Troy\" '"P:\Stock Room\"
Const ROOT_TARGET_FOLDER As String = "C:\test\Anne Troy Target\" '"S\Some Folder\"

Public Sub Folders()
Dim i As Long
Dim sFolder As String

Set FSO = CreateObject("Scripting.FileSystemObject")

SelectFiles ROOT_SOURCE_FOLDER

End Sub

'-----------------------------------------------------------------------
Sub SelectFiles(Optional FilePath As String)
'-----------------------------------------------------------------------
Dim Fileshort As String
Dim Filenum As Long
Dim FileFolder As String
Dim Foldertarget As String
Dim fldr As Object
Dim Folder As Object
Dim file As Object
Dim Files As Object

Set Folder = FSO.GetFolder(FilePath)

Set Files = Folder.Files
For Each file In Files

Fileshort = Left$(file.Name, InStrRev(file.Name, ".") - 1)
If InStr(Fileshort, "-") > 0 Then
Filenum = Left$(file.Name, InStrRev(file.Name, "-") - 1)
Else
Filenum = CLng(Fileshort)
End If
FileFolder = ((Filenum - 1) \ 100) * 100 + 1 & "-" & ((Filenum - 1) \ 100 + 1) * 100
Foldertarget = ROOT_TARGET_FOLDER & FileFolder
On Error Resume Next
MkDir Foldertarget
On Error GoTo 0
Name file.Path As Foldertarget & Application.PathSeparator & file.Name
Next file

For Each fldr In Folder.Subfolders
SelectFiles fldr.Path
Next

End Sub
[/vba]

[Anne Troy]

OMG. I am incredibly humbled.

And now realize I goofed!
Instead of 7777.pdf and 7777-1.pdf, they are actually 7777.pdf and 7777(1).pdf when a duplicate is made.

I am sooooo sorry. Your code is incredibly perfect.
Can you fix it for me? I looked, but can't begin to guess how to change it...

[Anne Troy]

By the way, Ron, your second layout is what I was needing.

[Bob Phillips]

Clarify something please Anne.

I can see that you want a file called 271 PDF to go to ...\201-300\271\271.pdf, but will you start with files called 201.pdf and 201(1).pdf, and both are to be transferred, or will you have say 201.pdf one day which gets transferred, and then 201.pdf another day, and when that is transferred, it doesn't overwrite the fisrt, but creates 201(1).pdf, etc.?

[Bob Phillips]

This version doesn't matter, it handles both

[vba]

Private FSO As Object
Private Const ROOT_SOURCE_FOLDER As String = "P:\Stock Room\"
Private Const ROOT_TARGET_FOLDER As String = "S\Some Folder\"

Public Sub Folders()
Dim i As Long
Dim sFolder As String

Set FSO = CreateObject("Scripting.FileSystemObject")

SelectFiles ROOT_SOURCE_FOLDER

End Sub

'-----------------------------------------------------------------------
Sub SelectFiles(Optional FilePath As String)
'-----------------------------------------------------------------------
Dim FileShort As String
Dim Filenum As Long
Dim FileVersion As Long
Dim FileFolder As String
Dim FolderTarget As String
Dim FileExt As String
Dim FileTarget As String
Dim fldr As Object
Dim Folder As Object
Dim file As Object
Dim Files As Object

Set Folder = FSO.GetFolder(FilePath)

Set Files = Folder.Files
For Each file In Files

FileShort = Left$(file.Name, InStrRev(file.Name, ".") - 1)
FileExt = Mid$(file.Name, InStrRev(file.Name, "."))
If InStr(FileShort, "(") > 0 Then
Filenum = Left$(file.Name, InStrRev(file.Name, "(") - 1)
FileVersion = Mid$(file.Name, InStrRev(file.Name, "(") + 1, InStrRev(file.Name, ")") - InStrRev(file.Name, "(") - 1)
Else
Filenum = CLng(FileShort)
FileVersion = 0
End If
FileFolder = ((Filenum - 1) \ 100) * 100 + 1 & "-" & ((Filenum - 1) \ 100 + 1) * 100
FolderTarget = ROOT_TARGET_FOLDER & FileFolder
On Error Resume Next
MkDir FolderTarget
MkDir FolderTarget & Application.PathSeparator & Filenum
On Error GoTo 0
FileTarget = FolderTarget & Application.PathSeparator & Filenum & Application.PathSeparator & file.Name
Do Until Not FSO.fileexists(FileTarget)
FileVersion = FileVersion + 1
FileTarget = FolderTarget & Application.PathSeparator & Filenum & "\" & Filenum & "(" & FileVersion & ")" & FileExt
Loop
Name file.Path As FileTarget
Next file

For Each fldr In Folder.Subfolders
SelectFiles fldr.Path
Next

End Sub
[/vba]

[Anne Troy]

LOL! Thanks, xld.

Yes, it creates those files on any given day. There will ALWAYS be a 201.pdf (if 201 has some paper) and sometimes there will be a 201(1).pdf and maybe even 201(2).pdf. I ALWAYS want to move them into a folder called 201 (if it doesn't exist, create it) and number them 201.pdf, 201-1.pdf, 201-2.pdf and so on, regardless of the day they're moved into the folder and regardless of how many files are moved into the folder.

I'm going to try the new code shortly.

Thanks again, soooooo much, Bob.

[Anne Troy]

Okay. I used file names 7777(1).pdf and 7777.pdf and 7777(2).pdf and it seemed to correctly move them to a new folder, but did not rename them to 7777.pdf, 7777-1.pdf, 7777-2.pdf.

That is FINE, it's just a syntax thing. I don't care if it's (1) or -1, as long as the code won't get fouled up with the existence of previous filenames.

[Bob Phillips]

You're a typical user Anne, always changing your mind

[vba]

Private FSO As Object
Private Const ROOT_SOURCE_FOLDER As String = "P:\Stock Room\"
Private Const ROOT_TARGET_FOLDER As String = "S\Some Folder\"

Public Sub Folders()
Dim i As Long
Dim sFolder As String

Set FSO = CreateObject("Scripting.FileSystemObject")

SelectFiles ROOT_SOURCE_FOLDER

End Sub

'-----------------------------------------------------------------------
Sub SelectFiles(Optional FilePath As String)
'-----------------------------------------------------------------------
Dim FileShort As String
Dim Filenum As Long
Dim FileVersion As Long
Dim FileFolder As String
Dim FolderTarget As String
Dim FileExt As String
Dim FileTarget As String
Dim fldr As Object
Dim Folder As Object
Dim file As Object
Dim Files As Object

Set Folder = FSO.GetFolder(FilePath)

Set Files = Folder.Files
For Each file In Files

FileShort = Left$(file.Name, InStrRev(file.Name, ".") - 1)
FileShort = Replace(Replace(FileShort, ")", ""), "(", "-")
FileExt = Mid$(file.Name, InStrRev(file.Name, "."))
If InStr(FileShort, "-") > 0 Then
Filenum = Left$(FileShort, InStrRev(FileShort, "-") - 1)
FileVersion = Mid$(FileShort, InStrRev(FileShort, "-") + 1, Len(FileShort) - InStrRev(FileShort, "-"))
Else
Filenum = CLng(FileShort)
FileVersion = 0
End If
FileFolder = ((Filenum - 1) \ 100) * 100 + 1 & "-" & ((Filenum - 1) \ 100 + 1) * 100
FolderTarget = ROOT_TARGET_FOLDER & FileFolder
On Error Resume Next
MkDir FolderTarget
MkDir FolderTarget & Application.PathSeparator & Filenum
On Error GoTo 0
FileTarget = FolderTarget & Application.PathSeparator & Filenum & Application.PathSeparator & FileShort & FileExt
Do Until Not FSO.fileexists(FileTarget)
FileVersion = FileVersion + 1
FileTarget = FolderTarget & Application.PathSeparator & Filenum & "\" & Filenum & "-" & FileVersion & FileExt
Loop
Name file.Path As FileTarget
Next file

For Each fldr In Folder.Subfolders
SelectFiles fldr.Path
Next

End Sub
[/vba]

[Anne Troy]

I love it when you talk dirty.

And YOU are a typical MVP. Going WAY beyond the call of duty. Thanks again, dude.

[Anne Troy]

I love you. It's perfect. Thanks a ton!!

[Anne Troy]

I've been using this macro for a couple of days now, and it works incredibly well. I cannot believe the time THEY were wasting (without question of an easier way), and the time YOU have saved me. Thanks again, Bob.

[Bob Phillips]

It is quite amazing how many people will sit in front of a screen doing the same thing day in and day out and not even ask if there were some way to automate it.