Plan to automate filing - would it work and if so what code could I use?

A

alf810

New Member
Joined
Dec 30, 2015
Messages
17
Some background: I scan tons of paperwork and lately our company has had double the workload due to a merger. It's an absolute nightmare. Anyway, I have a background a long time ago with setting up advanced macros in excel's vba and just came up with an idea of how to make the job a bit easier (hopefully).

I would file each packet of work into the scanner and (from the scanner) name the file by the persons first two letters of their surname followed by their account number they have with us. For example: John Smith who has an account #555 would be named sm555 before getting scanned into a folder on my computer.

This is where the macro part kicks in. Could I run a macro from Excel that will look at that file and understand roughly where to put it? For example, our file system is set up like this for surnames:
Aa-Al, Am-Az, Ba-Bl, Bm-Bz, etc...

So you can see why I listed John Smith as sm, it's so the VBA code can look at the sm and know to go to the folder Sm-Sz. It would then check to see if there is a folder with the number 555 (it's VERY important that it only looks for the exact number, don't want to accidentally file into a person whose account is 20555, for example)

If it finds that number it then moves that file into that account folder. If it doesn't find the number (meaning it's a new patient and needs a new folder created) then i'd like it to be sent to a folder I have in my documents, which I would go through and manually do myself.

Also the numbers in the folders always have # in front of them and the folders are in a format to be surname, followed by full name if that helps. So John Smith's folder would literally be called Smith, John #555

I'd really appreciate any help - there is still a lot more to my job than just this (for one taking out staples, making sure there are no backsides, filing single sheet files which is very time consuming and can't use this method, plus we have paperless faxed over scans I do, plus alphabetizing the cupboard, etc... so I'm not just trying to look for a way to automate my job, I'm just burned-out and also believe if indeed technology can automate it then why not? Again I appreciate it :)
 

Excel Facts

Fastest way to copy a worksheet?
Hold down the Ctrl key while dragging tab for Sheet1 to the right. Excel will make a copy of the worksheet.
Sort by date Sort by votes
Here's some code I came up with. You'll need to modify the constants to your situation. Hope this helps!

Code: 
Sub MoveCustomerDocument(DocumentPath As String)

Const CustomerDocumentsDirectoryPath As String = "C:\CustomerDocs"
Const NewCustomerDocumentsDirectoryPath As String = "C:\NewCustomers"

Dim FSO As Scripting.FileSystemObject
Dim CustomerDocumentsDirectory As Scripting.Folder
Dim CustomerDirectory As Scripting.Folder

Dim DestinationDirectoryPath As String

Dim DocumentName As String
Dim SurnamePrefix As String
Dim AccountNumber As String

  Set FSO = CreateObject("Scripting.FileSystemObject")

  'There could be room for error checking in this section in case an improper file name is passed into the function i.e. "arc123" instead of "ar123"
  SurnamePrefix = Left$(FSO.GetBaseName(DocumentPath), 2)
  AccountNumber = Mid$(FSO.GetBaseName(DocumentPath), 3)
  Set CustomerDocumentsDirectory = FSO.GetFolder(CustomerDocumentsDirectoryPath)
  
  Set CustomerDirectory = FindCustomerFolder(SurnamePrefix, AccountNumber, CustomerDocumentsDirectory)
  
  If CustomerDirectory Is Nothing Then
    DestinationDirectoryPath = NewCustomerDocumentsDirectoryPath
  Else
    DestinationDirectoryPath = CustomerDirectory.Path
  End If
  
  FSO.MoveFile DocumentPath, FSO.BuildPath(DestinationDirectoryPath, FSO.GetFileName(DocumentPath))

End Sub

Function FindCustomerFolder(SurnamePrefix As String, AccountNumber As String, CustomerDocumentsDirectory As Object) As Object

Dim Folder As Object 'Scripting.Folder
Dim SurnameGroupFolder As Scripting.Folder 'Object '
  
  'Loops through each Surname-Group Folder Alphabetically
  For Each Folder In CustomerDocumentsDirectory.SubFolders 'Subfolders are the GroupFolders followed by the Actual Customer's Directory
  
    'Stop once we've found a folder that is "greater than" the surname (Case Insensitive)
    If StrComp(Left$(Folder.Name, 2), SurnamePrefix, vbTextCompare) = 1 Then
      Exit For
    End If
    
    Set SurnameGroupFolder = Folder
  Next Folder
  
  'Search through the SurnameGroupFolder for a folder that matches the account number
  For Each Folder In SurnameGroupFolder.SubFolders
    If Folder.Name Like "*[#]" & AccountNumber Then
      Set FindCustomerFolder = Folder
      Exit Function
    End If
  Next Folder

End Function
 
Upvote 0
Thanks LockeGarmin, I really appreciate it! I'm going to be trying it over the course of some time, fiddling with it, testing it, etc... They really should be giving me a raise for this thing (my title is just File Clerk lol), so it's something I'm self-initializing due to heavy workload. Anyway, I hope it works and thanks again!
 
Upvote 0
You're welcome! I just realized that I didn't make it fully late-binding so it will work right out of the box. You can either add a reference to the Microsoft Scripting Runtime Library or just use the code below. Good luck!

Code: 
Option Explicit

Sub MoveCustomerDocument(DocumentPath As String)

Const CustomerDocumentsDirectoryPath As String = "C:\CustomerDocs"
Const NewCustomerDocumentsDirectoryPath As String = "C:\NewCustomers"

Dim FSO As Object 'Scripting.FileSystemObject
Dim CustomerDocumentsDirectory As Object 'Scripting.Folder
Dim CustomerDirectory As Object 'Scripting.Folder

Dim DestinationDirectoryPath As String

Dim DocumentName As String
Dim SurnamePrefix As String
Dim AccountNumber As String

  Set FSO = CreateObject("Scripting.FileSystemObject")

  'There could be room for error checking in this section in case an improper file name is passed into the function i.e. "arc123" instead of "ar123"
  SurnamePrefix = Left$(FSO.GetBaseName(DocumentPath), 2)
  AccountNumber = Mid$(FSO.GetBaseName(DocumentPath), 3)
  Set CustomerDocumentsDirectory = FSO.GetFolder(CustomerDocumentsDirectoryPath)
  
  Set CustomerDirectory = FindCustomerFolder(SurnamePrefix, AccountNumber, CustomerDocumentsDirectory)
  
  If CustomerDirectory Is Nothing Then
    DestinationDirectoryPath = NewCustomerDocumentsDirectoryPath
  Else
    DestinationDirectoryPath = CustomerDirectory.Path
  End If
  
  FSO.MoveFile DocumentPath, FSO.BuildPath(DestinationDirectoryPath, FSO.GetFileName(DocumentPath))

End Sub

Function FindCustomerFolder(SurnamePrefix As String, AccountNumber As String, CustomerDocumentsDirectory As Object) As Object

Dim Folder As Object 'Scripting.Folder
Dim SurnameGroupFolder As Object 'Scripting.Folder
  
  'Loops through each Surname-Group Folder Alphabetically
  For Each Folder In CustomerDocumentsDirectory.SubFolders 'Subfolders are the GroupFolders followed by the Actual Customer's Directory
  
    'Stop once we've found a folder that is "greater than" the surname (Case Insensitive)
    If StrComp(Left$(Folder.Name, 2), SurnamePrefix, vbTextCompare) = 1 Then
      Exit For
    End If
    
    Set SurnameGroupFolder = Folder
  Next Folder
  
  'Search through the SurnameGroupFolder for a folder that matches the account number
  For Each Folder In SurnameGroupFolder.SubFolders
    If Folder.Name Like "*[#]" & AccountNumber Then
      Set FindCustomerFolder = Folder
      Exit Function
    End If
  Next Folder

End Function
 
Upvote 0
LockeGarmin said:
You're welcome! I just realized that I didn't make it fully late-binding so it will work right out of the box. You can either add a reference to the Microsoft Scripting Runtime Library or just use the code below. Good luck!

Code: 
Option Explicit

Sub MoveCustomerDocument(DocumentPath As String)

Const CustomerDocumentsDirectoryPath As String = "C:\CustomerDocs"
Const NewCustomerDocumentsDirectoryPath As String = "C:\NewCustomers"

Dim FSO As Object 'Scripting.FileSystemObject
Dim CustomerDocumentsDirectory As Object 'Scripting.Folder
Dim CustomerDirectory As Object 'Scripting.Folder

Dim DestinationDirectoryPath As String

Dim DocumentName As String
Dim SurnamePrefix As String
Dim AccountNumber As String

  Set FSO = CreateObject("Scripting.FileSystemObject")

  'There could be room for error checking in this section in case an improper file name is passed into the function i.e. "arc123" instead of "ar123"
  SurnamePrefix = Left$(FSO.GetBaseName(DocumentPath), 2)
  AccountNumber = Mid$(FSO.GetBaseName(DocumentPath), 3)
  Set CustomerDocumentsDirectory = FSO.GetFolder(CustomerDocumentsDirectoryPath)
  
  Set CustomerDirectory = FindCustomerFolder(SurnamePrefix, AccountNumber, CustomerDocumentsDirectory)
  
  If CustomerDirectory Is Nothing Then
    DestinationDirectoryPath = NewCustomerDocumentsDirectoryPath
  Else
    DestinationDirectoryPath = CustomerDirectory.Path
  End If
  
  FSO.MoveFile DocumentPath, FSO.BuildPath(DestinationDirectoryPath, FSO.GetFileName(DocumentPath))

End Sub

Function FindCustomerFolder(SurnamePrefix As String, AccountNumber As String, CustomerDocumentsDirectory As Object) As Object

Dim Folder As Object 'Scripting.Folder
Dim SurnameGroupFolder As Object 'Scripting.Folder
  
  'Loops through each Surname-Group Folder Alphabetically
  For Each Folder In CustomerDocumentsDirectory.SubFolders 'Subfolders are the GroupFolders followed by the Actual Customer's Directory
  
    'Stop once we've found a folder that is "greater than" the surname (Case Insensitive)
    If StrComp(Left$(Folder.Name, 2), SurnamePrefix, vbTextCompare) = 1 Then
      Exit For
    End If
    
    Set SurnameGroupFolder = Folder
  Next Folder
  
  'Search through the SurnameGroupFolder for a folder that matches the account number
  For Each Folder In SurnameGroupFolder.SubFolders
    If Folder.Name Like "*[#]" & AccountNumber Then
      Set FindCustomerFolder = Folder
      Exit Function
    End If
  Next Folder

End Function
Click to expand...

Thanks again and sorry for the late reply! I recently did really well on a pre-interview excel test, so I'm hoping to change jobs anyway - having to fix this workplaces problems is above my pay grade of a file clerk lol. I am kind of nerdy, though, so even if my days at my current under-appreciated job are numbered I think I'll still play with the code you gave me and see if it works, maybe help out the next poor sap they give my position to.
 
Upvote 0
Hey LockeGarmin, I decided to try out the macro at home today. I went ahead and set up the folders and tried it out, but nothing happened. My VBA skills are lacking, so i could just be misunderstanding, but from what I can tell in the code it looks like there are only two folders instead of three. I reread my op post and realized it's I wasn't too clear, the scanner folder and patient directory are in two different places. Here are the folders:

1) the scanner folder where all the files scanned go into
2) the patient directory which is on our network
3) the new patients folder (which I think is the one in the code) where the patient's who don't have a folder yet go, so I can manually file it.

Thanks again so much for your help! I really appreciate it! If I'm just doing something wrong or if there is a third folder missing please let me know, Thanks again :) !
 
Upvote 0
1) the scanner folder where all the files scanned go into
Click to expand...
Code: 
Sub MoveCustomerDocument(DocumentPath As String)
2) the patient directory which is on our network
Click to expand...
Code: 
Const CustomerDocumentsDirectoryPath As String = "C:\CustomerDocs"
3) the new patients folder (which I think is the one in the code) where the patient's who don't have a folder yet go, so I can manually file it.
Click to expand...
Code: 
Const NewCustomerDocumentsDirectoryPath As String = "C:\NewCustomers"

The way I went about it was actually to use the "MoveCustomerDocument" sub to move a single file based on the criteria laid out (Moving it to the network vs new customer files). That way you can use that sub in a loop how you best see fit. Perhaps something like the following:

Code: 
Sub MoveFiles()

Dim Folder As Object
Dim File As Object

Const FolderPath As String = "C:\Temp\FilesToMove"


  Set Folder = CreateObject("Scripting.FileSystemObject").GetFolder(FolderPath)
  
  For Each File In Folder.Files
    Call MoveCustomerDocument(File.Path)
  Next File
  
End Sub
 
Upvote 0
Thanks again for helping out Locke, I'm new to VBA, so I'm trying to do it the best I can, mainly because I want to help the next file clerk, who I know, if indeed I do get transfered to a better job in the hospital (which I hope I do...). Anyway, the file paths in the code below represent how they will actually be on our network drives. I still get some errors which I've mentioned below.

Ok, so here's what I have so far:

Code: 
[COLOR=black][FONT=Arial]Sub MoveFiles()[/FONT][/COLOR]
[COLOR=#212121][FONT=Segoe UI][FONT=Times New Roman][SIZE=3][FONT=Arial][SIZE=2][COLOR=black]Dim Folder As Object[/COLOR][/SIZE][/FONT][/SIZE][/FONT][/FONT][/COLOR]
[COLOR=#212121][FONT=Segoe UI][FONT=Times New Roman][SIZE=3][FONT=Arial][SIZE=2][COLOR=black]Dim File As Object[/COLOR][/SIZE][/FONT][/SIZE][/FONT][/FONT][/COLOR]

[COLOR=#212121][FONT=Segoe UI][FONT=Times New Roman][SIZE=3][FONT=Arial][SIZE=2][COLOR=black]Const FolderPath As String = "X:\test"[/COLOR][/SIZE][/FONT][/SIZE][/FONT][/FONT][/COLOR]


[COLOR=#212121][FONT=Segoe UI][FONT=Times New Roman][SIZE=3][FONT=Arial][SIZE=2][COLOR=black]  Set Folder = CreateObject("Scripting.FileSystemObject").GetFolder(FolderPath)[/COLOR][/SIZE][/FONT][/SIZE][/FONT][/FONT][/COLOR]

[COLOR=#212121][FONT=Segoe UI][FONT=Times New Roman][SIZE=3][FONT=Arial][SIZE=2][COLOR=black]  For Each File In Folder.Files[/COLOR][/SIZE][/FONT][/SIZE][/FONT][/FONT][/COLOR]
[COLOR=#212121][FONT=Segoe UI][FONT=Times New Roman][SIZE=3][FONT=Arial][SIZE=2][COLOR=black]    Call MoveCustomerDocument(File.Path)[/COLOR][/SIZE][/FONT][/SIZE][/FONT][/FONT][/COLOR]
[COLOR=#212121][FONT=Segoe UI][FONT=Times New Roman][SIZE=3][FONT=Arial][SIZE=2][COLOR=black]  Next File[/COLOR][/SIZE][/FONT][/SIZE][/FONT][/FONT][/COLOR]

[COLOR=#212121][FONT=Segoe UI][FONT=Times New Roman][SIZE=3][FONT=Arial][SIZE=2][COLOR=black]End Sub[/COLOR][/SIZE][/FONT][/SIZE][/FONT][/FONT][/COLOR]
[COLOR=#212121][FONT=Segoe UI][FONT=Times New Roman][SIZE=3][FONT=Arial][SIZE=2][COLOR=black]Sub MoveCustomerDocument(DocumentPath As String)[/COLOR][/SIZE][/FONT][/SIZE][/FONT][/FONT][/COLOR]

[COLOR=#212121][FONT=Segoe UI][FONT=Times New Roman][SIZE=3][FONT=Arial][SIZE=2][COLOR=black]Const CustomerDocumentsDirectoryPath As String = "Y:\"[/COLOR][/SIZE][/FONT][/SIZE][/FONT][/FONT][/COLOR]
[COLOR=#212121][FONT=Segoe UI][FONT=Times New Roman][SIZE=3][FONT=Arial][SIZE=2][COLOR=black]Const NewCustomerDocumentsDirectoryPath As String = "X:\NEW DOCUMENTS"[/COLOR][/SIZE][/FONT][/SIZE][/FONT][/FONT][/COLOR]

[COLOR=#212121][FONT=Segoe UI][FONT=Times New Roman][SIZE=3][FONT=Arial][SIZE=2][COLOR=black]Dim FSO As Object 'Scripting.FileSystemObject[/COLOR][/SIZE][/FONT][/SIZE][/FONT][/FONT][/COLOR]
[COLOR=#212121][FONT=Segoe UI][FONT=Times New Roman][SIZE=3][FONT=Arial][SIZE=2][COLOR=black]Dim CustomerDocumentsDirectory As Object 'Scripting.Folder[/COLOR][/SIZE][/FONT][/SIZE][/FONT][/FONT][/COLOR]
[COLOR=#212121][FONT=Segoe UI][FONT=Times New Roman][SIZE=3][FONT=Arial][SIZE=2][COLOR=black]Dim CustomerDirectory As Object 'Scripting.Folder[/COLOR][/SIZE][/FONT][/SIZE][/FONT][/FONT][/COLOR]

[COLOR=#212121][FONT=Segoe UI][FONT=Times New Roman][SIZE=3][FONT=Arial][SIZE=2][COLOR=black]Dim DestinationDirectoryPath As String[/COLOR][/SIZE][/FONT][/SIZE][/FONT][/FONT][/COLOR]

[COLOR=#212121][FONT=Segoe UI][FONT=Times New Roman][SIZE=3][FONT=Arial][SIZE=2][COLOR=black]Dim DocumentName As String[/COLOR][/SIZE][/FONT][/SIZE][/FONT][/FONT][/COLOR]
[COLOR=#212121][FONT=Segoe UI][FONT=Times New Roman][SIZE=3][FONT=Arial][SIZE=2][COLOR=black]Dim SurnamePrefix As String[/COLOR][/SIZE][/FONT][/SIZE][/FONT][/FONT][/COLOR]
[COLOR=#212121][FONT=Segoe UI][FONT=Times New Roman][SIZE=3][FONT=Arial][SIZE=2][COLOR=black]Dim AccountNumber As String[/COLOR][/SIZE][/FONT][/SIZE][/FONT][/FONT][/COLOR]

[COLOR=#212121][FONT=Segoe UI][FONT=Times New Roman][SIZE=3][FONT=Arial][SIZE=2][COLOR=black]  Set FSO = CreateObject("Scripting.FileSystemObject")[/COLOR][/SIZE][/FONT][/SIZE][/FONT][/FONT][/COLOR]

[COLOR=#212121][FONT=Segoe UI][FONT=Times New Roman][SIZE=3][FONT=Arial][SIZE=2][COLOR=black]  'There could be room for error checking in this section in case an improper file name is passed into the function i.e. "arc123" instead of "ar123"[/COLOR][/SIZE][/FONT][/SIZE][/FONT][/FONT][/COLOR]
[COLOR=#212121][FONT=Segoe UI][FONT=Times New Roman][SIZE=3][FONT=Arial][SIZE=2][COLOR=black]  SurnamePrefix = Left$(FSO.GetBaseName(DocumentPath), 2)[/COLOR][/SIZE][/FONT][/SIZE][/FONT][/FONT][/COLOR]
[COLOR=#212121][FONT=Segoe UI][FONT=Times New Roman][SIZE=3][FONT=Arial][SIZE=2][COLOR=black]  AccountNumber = Mid$(FSO.GetBaseName(DocumentPath), 5)[/COLOR][/SIZE][/FONT][/SIZE][/FONT][/FONT][/COLOR]
[COLOR=#212121][FONT=Segoe UI][FONT=Times New Roman][SIZE=3][FONT=Arial][SIZE=2][COLOR=black]  Set CustomerDocumentsDirectory = FSO.GetFolder(CustomerDocumentsDirectoryPath)[/COLOR][/SIZE][/FONT][/SIZE][/FONT][/FONT][/COLOR]

[COLOR=#212121][FONT=Segoe UI][FONT=Times New Roman][SIZE=3][FONT=Arial][SIZE=2][COLOR=black]  Set CustomerDirectory = FindCustomerFolder(SurnamePrefix, AccountNumber, CustomerDocumentsDirectory)[/COLOR][/SIZE][/FONT][/SIZE][/FONT][/FONT][/COLOR]

[COLOR=#212121][FONT=Segoe UI][FONT=Times New Roman][SIZE=3][FONT=Arial][SIZE=2][COLOR=black]  If CustomerDirectory Is Nothing Then[/COLOR][/SIZE][/FONT][/SIZE][/FONT][/FONT][/COLOR]
[COLOR=#212121][FONT=Segoe UI][FONT=Times New Roman][SIZE=3][FONT=Arial][SIZE=2][COLOR=black]    DestinationDirectoryPath = NewCustomerDocumentsDirectoryPath[/COLOR][/SIZE][/FONT][/SIZE][/FONT][/FONT][/COLOR]
[COLOR=#212121][FONT=Segoe UI][FONT=Times New Roman][SIZE=3][FONT=Arial][SIZE=2][COLOR=black]  Else[/COLOR][/SIZE][/FONT][/SIZE][/FONT][/FONT][/COLOR]
[COLOR=#212121][FONT=Segoe UI][FONT=Times New Roman][SIZE=3][FONT=Arial][SIZE=2][COLOR=black]    DestinationDirectoryPath = CustomerDirectory.Path[/COLOR][/SIZE][/FONT][/SIZE][/FONT][/FONT][/COLOR]
[COLOR=#212121][FONT=Segoe UI][FONT=Times New Roman][SIZE=3][FONT=Arial][SIZE=2][COLOR=black]  End If[/COLOR][/SIZE][/FONT][/SIZE][/FONT][/FONT][/COLOR]

[COLOR=#212121][FONT=Segoe UI][FONT=Times New Roman][SIZE=3][FONT=Arial][SIZE=2][COLOR=black]  FSO.MoveFile DocumentPath, FSO.BuildPath(DestinationDirectoryPath, FSO.GetFileName(DocumentPath))[/COLOR][/SIZE][/FONT][/SIZE][/FONT][/FONT][/COLOR]

[COLOR=#212121][FONT=Segoe UI][FONT=Times New Roman][SIZE=3][FONT=Arial][SIZE=2][COLOR=black]End Sub[/COLOR][/SIZE][/FONT][/SIZE][/FONT][/FONT][/COLOR]

[COLOR=#212121][FONT=Segoe UI][FONT=Times New Roman][SIZE=3][FONT=Arial][SIZE=2][COLOR=black]Function FindCustomerFolder(SurnamePrefix As String, AccountNumber As String, CustomerDocumentsDirectory As Object) As Object[/COLOR][/SIZE][/FONT][/SIZE][/FONT][/FONT][/COLOR]

[COLOR=#212121][FONT=Segoe UI][FONT=Times New Roman][SIZE=3][FONT=Arial][SIZE=2][COLOR=black]Dim Folder As Object 'Scripting.Folder[/COLOR][/SIZE][/FONT][/SIZE][/FONT][/FONT][/COLOR]
[COLOR=#212121][FONT=Segoe UI][FONT=Times New Roman][SIZE=3][FONT=Arial][SIZE=2][COLOR=black]Dim SurnameGroupFolder As Object 'Scripting.Folder[/COLOR][/SIZE][/FONT][/SIZE][/FONT][/FONT][/COLOR]

[COLOR=#212121][FONT=Segoe UI][FONT=Times New Roman][SIZE=3][FONT=Arial][SIZE=2][COLOR=black]  'Loops through each Surname-Group Folder Alphabetically[/COLOR][/SIZE][/FONT][/SIZE][/FONT][/FONT][/COLOR]
[COLOR=#212121][FONT=Segoe UI][FONT=Times New Roman][SIZE=3][FONT=Arial][SIZE=2][COLOR=black]  For Each Folder In CustomerDocumentsDirectory.SubFolders 'Subfolders are the GroupFolders followed by the Actual Customer's Directory[/COLOR][/SIZE][/FONT][/SIZE][/FONT][/FONT][/COLOR]

[COLOR=#212121][FONT=Segoe UI][FONT=Times New Roman][SIZE=3][FONT=Arial][SIZE=2][COLOR=black]    'Stop once we've found a folder that is "greater than" the surname (Case Insensitive)[/COLOR][/SIZE][/FONT][/SIZE][/FONT][/FONT][/COLOR]
[COLOR=#212121][FONT=Segoe UI][FONT=Times New Roman][SIZE=3][FONT=Arial][SIZE=2][COLOR=black]    If StrComp(Left$(Folder.Name, 2), SurnamePrefix, vbTextCompare) = 1 Then[/COLOR][/SIZE][/FONT][/SIZE][/FONT][/FONT][/COLOR]
[COLOR=#212121][FONT=Segoe UI][FONT=Times New Roman][SIZE=3][FONT=Arial][SIZE=2][COLOR=black]      Exit For[/COLOR][/SIZE][/FONT][/SIZE][/FONT][/FONT][/COLOR]
[COLOR=#212121][FONT=Segoe UI][FONT=Times New Roman][SIZE=3][FONT=Arial][SIZE=2][COLOR=black]    End If[/COLOR][/SIZE][/FONT][/SIZE][/FONT][/FONT][/COLOR]

[COLOR=#212121][FONT=Segoe UI][FONT=Times New Roman][SIZE=3][FONT=Arial][SIZE=2][COLOR=black]    Set SurnameGroupFolder = Folder[/COLOR][/SIZE][/FONT][/SIZE][/FONT][/FONT][/COLOR]
[COLOR=#212121][FONT=Segoe UI][FONT=Times New Roman][SIZE=3][FONT=Arial][SIZE=2][COLOR=black]  Next Folder[/COLOR][/SIZE][/FONT][/SIZE][/FONT][/FONT][/COLOR]

[COLOR=#212121][FONT=Segoe UI][FONT=Times New Roman][SIZE=3][FONT=Arial][SIZE=2][COLOR=black]  'Search through the SurnameGroupFolder for a folder that matches the account number[/COLOR][/SIZE][/FONT][/SIZE][/FONT][/FONT][/COLOR]
[COLOR=#212121][FONT=Segoe UI][FONT=Times New Roman][SIZE=3][FONT=Arial][SIZE=2][COLOR=black]  For Each Folder In SurnameGroupFolder.SubFolders[/COLOR][/SIZE][/FONT][/SIZE][/FONT][/FONT][/COLOR]
[COLOR=#212121][FONT=Segoe UI][FONT=Times New Roman][SIZE=3][FONT=Arial][SIZE=2][COLOR=black]    If Folder.Name Like "*[#]" & AccountNumber Then[/COLOR][/SIZE][/FONT][/SIZE][/FONT][/FONT][/COLOR]
[COLOR=#212121][FONT=Segoe UI][FONT=Times New Roman][SIZE=3][FONT=Arial][SIZE=2][COLOR=black]      Set FindCustomerFolder = Folder[/COLOR][/SIZE][/FONT][/SIZE][/FONT][/FONT][/COLOR]
[COLOR=#212121][FONT=Segoe UI][FONT=Times New Roman][SIZE=3][FONT=Arial][SIZE=2][COLOR=black]      Exit Function[/COLOR][/SIZE][/FONT][/SIZE][/FONT][/FONT][/COLOR]
[COLOR=#212121][FONT=Segoe UI][FONT=Times New Roman][SIZE=3][FONT=Arial][SIZE=2][COLOR=black]    End If[/COLOR][/SIZE][/FONT][/SIZE][/FONT][/FONT][/COLOR]
[COLOR=#212121][FONT=Segoe UI][FONT=Times New Roman][SIZE=3][FONT=Arial][SIZE=2][COLOR=black]  Next Folder[/COLOR][/SIZE][/FONT][/SIZE][/FONT][/FONT][/COLOR]

[COLOR=black][FONT=Arial]End Function[/FONT][/COLOR]



When I go in debug mode it doesn’t seem to understand what
Dim CustomerDirectory As Object is, because it says CustomerDirectory = nothing

Also, sometimes it gives this error:

Run-time error ‘438’:Object doesn't support this property or method
Click to expand...

When debugged it points to
for each file in the folder
Click to expand...



I also thought I would mentioned enabled libraries, although I don't think that's the issue:
References show the following installed:
Visual Basic for Applications
Microsoft Excel 14.0 Object Library
OLE Automation
Microsoft Office 14.0 Object Library (don’t know why it repeated twice)
But there are a lot more not checked off.
 
Upvote 0
Does Excel VBA have a hard time handling network drives?

Long story short: I'm scanning in document packets one at a time into a scanner, naming the file by the customers first two initials of their last name, as well as their account number. Then the macro will go through the list of scanned documents and put the files into a customer directory that is alphabetized as follows: AA-AL, AM-AZ, BA-BL, BM-BZ, etc...

Knowing the two initials and account numbers, as well as the directories where the scanned files are and where the customer files are should be enough for the macro to know where to put them. If it can't find the folder, then a folder has to be made so the macro just puts the file in a folder that I go through manually.

Here's the code I'm using at the moment:

Code: 
[COLOR=#000000][FONT=Calibri]Option Explicit[/FONT][/COLOR][COLOR=#000000][FONT=Calibri]
[/FONT][/COLOR]
[COLOR=#000000][FONT=Calibri]Sub MoveFiles()[/FONT][/COLOR]
[COLOR=#000000][FONT=Calibri]
[/FONT][/COLOR]
[COLOR=#000000][FONT=Calibri]Dim Folder As Object[/FONT][/COLOR]
[COLOR=#000000][FONT=Calibri]Dim File As Object[/FONT][/COLOR]
[COLOR=#000000][FONT=Calibri]
[/FONT][/COLOR]
[COLOR=#000000][FONT=Calibri]Const FolderPath As String = "X:\FILES"[/FONT][/COLOR]
[COLOR=#000000][FONT=Calibri]
[/FONT][/COLOR]
[COLOR=#000000][FONT=Calibri]
[/FONT][/COLOR]
[COLOR=#000000][FONT=Calibri]  Set Folder = CreateObject("Scripting.FileSystemObject").GetFolder(FolderPath)[/FONT][/COLOR]
[COLOR=#000000][FONT=Calibri]  [/FONT][/COLOR]
[COLOR=#000000][FONT=Calibri]  For Each File In Folder.Files[/FONT][/COLOR]
[COLOR=#000000][FONT=Calibri]    Call MoveCustomerDocument(File.Path)[/FONT][/COLOR]
[COLOR=#000000][FONT=Calibri]  Next File[/FONT][/COLOR]
[COLOR=#000000][FONT=Calibri]
[/FONT][/COLOR]
[COLOR=#000000][FONT=Calibri]End Sub[/FONT][/COLOR]
[COLOR=#000000][FONT=Calibri]
[/FONT][/COLOR]
[COLOR=#000000][FONT=Calibri]
[/FONT][/COLOR]
[COLOR=#000000][FONT=Calibri]Sub MoveCustomerDocument(DocumentPath As String)[/FONT][/COLOR]
[COLOR=#000000][FONT=Calibri]
[/FONT][/COLOR]
[COLOR=#000000][FONT=Calibri]
[/FONT][/COLOR]
[COLOR=#000000][FONT=Calibri]
[/FONT][/COLOR]
[COLOR=#000000][FONT=Calibri]
[/FONT][/COLOR]
[COLOR=#000000][FONT=Calibri]Const CustomerDocumentsDirectoryPath As String = "Y:\"[/FONT][/COLOR]
[COLOR=#000000][FONT=Calibri]Const NewCustomerDocumentsDirectoryPath As String = "X:\NewCustomers"[/FONT][/COLOR]
[COLOR=#000000][FONT=Calibri]
[/FONT][/COLOR]
[COLOR=#000000][FONT=Calibri]Dim FSO As Object 'Scripting.FileSystemObject[/FONT][/COLOR]
[COLOR=#000000][FONT=Calibri]Dim CustomerDocumentsDirectory As Object 'Scripting.Folder[/FONT][/COLOR]
[COLOR=#000000][FONT=Calibri]Dim CustomerDirectory As Object 'Scripting.Folder[/FONT][/COLOR]
[COLOR=#000000][FONT=Calibri]
[/FONT][/COLOR]
[COLOR=#000000][FONT=Calibri]Dim DestinationDirectoryPath As String[/FONT][/COLOR]
[COLOR=#000000][FONT=Calibri]
[/FONT][/COLOR]
[COLOR=#000000][FONT=Calibri]Dim DocumentName As String[/FONT][/COLOR]
[COLOR=#000000][FONT=Calibri]Dim SurnamePrefix As String[/FONT][/COLOR]
[COLOR=#000000][FONT=Calibri]Dim AccountNumber As String[/FONT][/COLOR]
[COLOR=#000000][FONT=Calibri]
[/FONT][/COLOR]
[COLOR=#000000][FONT=Calibri]  Set FSO = CreateObject("Scripting.FileSystemObject")[/FONT][/COLOR]
[COLOR=#000000][FONT=Calibri]
[/FONT][/COLOR]
[COLOR=#000000][FONT=Calibri]  'There could be room for error checking in this section in case an improper file name is passed into the function i.e. "arc123" instead of "ar123"[/FONT][/COLOR]
[COLOR=#000000][FONT=Calibri]  SurnamePrefix = Left$(FSO.GetBaseName(DocumentPath), 2)[/FONT][/COLOR]
[COLOR=#000000][FONT=Calibri]  AccountNumber = Mid$(FSO.GetBaseName(DocumentPath), 3)[/FONT][/COLOR]
[COLOR=#000000][FONT=Calibri]  Set CustomerDocumentsDirectory = FSO.GetFolder(CustomerDocumentsDirectoryPath)[/FONT][/COLOR]
[COLOR=#000000][FONT=Calibri]  [/FONT][/COLOR]
[COLOR=#000000][FONT=Calibri]  Set CustomerDirectory = FindCustomerFolder(SurnamePrefix, AccountNumber, CustomerDocumentsDirectory)[/FONT][/COLOR]
[COLOR=#000000][FONT=Calibri]  [/FONT][/COLOR]
[COLOR=#000000][FONT=Calibri]  If CustomerDirectory Is Nothing Then[/FONT][/COLOR]
[COLOR=#000000][FONT=Calibri]    DestinationDirectoryPath = NewCustomerDocumentsDirectoryPath[/FONT][/COLOR]
[COLOR=#000000][FONT=Calibri]  Else[/FONT][/COLOR]
[COLOR=#000000][FONT=Calibri]    DestinationDirectoryPath = CustomerDirectory.Path[/FONT][/COLOR]
[COLOR=#000000][FONT=Calibri]  End If[/FONT][/COLOR]
[COLOR=#000000][FONT=Calibri]  [/FONT][/COLOR]
[COLOR=#000000][FONT=Calibri]  FSO.MoveFile DocumentPath, FSO.BuildPath(DestinationDirectoryPath, FSO.GetFileName(DocumentPath))[/FONT][/COLOR]
[COLOR=#000000][FONT=Calibri]
[/FONT][/COLOR]
[COLOR=#000000][FONT=Calibri]    [/FONT][/COLOR]
[COLOR=#000000][FONT=Calibri]
[/FONT][/COLOR]
[COLOR=#000000][FONT=Calibri]End Sub[/FONT][/COLOR]
[COLOR=#000000][FONT=Calibri]
[/FONT][/COLOR]
[COLOR=#000000][FONT=Calibri]Function FindCustomerFolder(SurnamePrefix As String, AccountNumber As String, CustomerDocumentsDirectory As Object) As Object[/FONT][/COLOR]
[COLOR=#000000][FONT=Calibri]
[/FONT][/COLOR]
[COLOR=#000000][FONT=Calibri]Dim Folder As Object 'Scripting.Folder[/FONT][/COLOR]
[COLOR=#000000][FONT=Calibri]Dim SurnameGroupFolder As Object 'Scripting.Folder[/FONT][/COLOR]
[COLOR=#000000][FONT=Calibri]  [/FONT][/COLOR]
[COLOR=#000000][FONT=Calibri]  'Loops through each Surname-Group Folder Alphabetically[/FONT][/COLOR]
[COLOR=#000000][FONT=Calibri]  For Each Folder In CustomerDocumentsDirectory.SubFolders 'Subfolders are the GroupFolders followed by the Actual Customer's Directory[/FONT][/COLOR]
[COLOR=#000000][FONT=Calibri]  [/FONT][/COLOR]
[COLOR=#000000][FONT=Calibri]    'Stop once we've found a folder that is "greater than" the surname (Case Insensitive)[/FONT][/COLOR]
[COLOR=#000000][FONT=Calibri]    If StrComp(Left$(Folder.Name, 2), SurnamePrefix, vbTextCompare) = 1 Then[/FONT][/COLOR]
[COLOR=#000000][FONT=Calibri]      Exit For[/FONT][/COLOR]
[COLOR=#000000][FONT=Calibri]    End If[/FONT][/COLOR]
[COLOR=#000000][FONT=Calibri]    [/FONT][/COLOR]
[COLOR=#000000][FONT=Calibri]    Set SurnameGroupFolder = Folder[/FONT][/COLOR]
[COLOR=#000000][FONT=Calibri]  Next Folder[/FONT][/COLOR]
[COLOR=#000000][FONT=Calibri]  [/FONT][/COLOR]
[COLOR=#000000][FONT=Calibri]  'Search through the SurnameGroupFolder for a folder that matches the account number[/FONT][/COLOR]
[COLOR=#000000][FONT=Calibri]  For Each Folder In SurnameGroupFolder.SubFolders[/FONT][/COLOR]
[COLOR=#000000][FONT=Calibri]    If Folder.Name Like "*[#]" & AccountNumber Then[/FONT][/COLOR]
[COLOR=#000000][FONT=Calibri]      Set FindCustomerFolder = Folder[/FONT][/COLOR]
[COLOR=#000000][FONT=Calibri]      Exit Function[/FONT][/COLOR]
[COLOR=#000000][FONT=Calibri]    End If[/FONT][/COLOR]
[COLOR=#000000][FONT=Calibri]  Next Folder[/FONT][/COLOR]
[COLOR=#000000][FONT=Calibri]
[/FONT][/COLOR]
[COLOR=#000000][FONT=Calibri]End Function[/FONT][/COLOR]

It works perfectly fine on my computer, but when I use it at work it complains, when I go in debug mode it says:

Dim CustomerDirectory As Object is, because it says CustomerDirectory = nothing

Also, sometimes it gives this error:
Run-time error ‘438’:Object doesn't support this property or method
Click to expand...

It also sometimes complains that Folder​ doesn't exist.

Here's my enabled references at home, I still have to review them at work:
Visual Basic for Applications
Microsoft Excel 14.0 Object Library
OLE Automation
Microsoft Office 14.0 Object Library (don’t know why, but it repeats twice)
 
Upvote 0
Re: Does Excel VBA have a hard time handling network drives?

Hmm, not really sure how to help. It kind of sounds like maybe the computer you're using at work doesn't have a good connection to the network and keeps losing the folder. If you put the folder path in windows explorer and press 'enter' does it navigate to that folder ok?
 
Upvote 0
You must log in or register to reply here.

Similar threads

A
  • Question Question
Automate Attendance Marking Based on Daily Schedule in Excel
Replies
1
Views
129
Peter_SSs
Peter_SSs
I
  • Question Question
Advice / Suggestion for what to do if two customers have the same name when adding to my worksheet.
Replies
4
Views
228
ipbr21054
I
C
  • Solved
Extracting data with VBA macro button from files in designated folder
2 3
Replies
20
Views
715
Micron
M
I
  • Question Question
Rename pdf using excel
Replies
9
Views
847
Micron
M
I
  • Solved
Advice to edit code so deleting by mistke doesnt happen
Replies
7
Views
596
ipbr21054
I

Forum statistics

Threads
1,223,249
Messages
6,171,031
Members
452,374
Latest member
keccles

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top