Hey everyone,
At my work I'm trying to use Excel VBA to take scanned PDF documents of patient information from the path they're scanned into and have a macro that will automatically go through the PDF files, look at the name of the files and be able to go to another path (patient accounts directly) and put said file into the correct patient folder.
Step-by-Step
Macro looks at the first PDF file in scanned folder
The PDF files will be named with two letters and up to six numbers. The letters represent the first two letters of the patient's last name, the number represents the account.
Macro looks at the two letters, goes to the patient accounts directly and determines the correct letter (folders are split as: Aa-Al, Am-Az, Ba-Bl, Bm-Bz, etc...)
Macro goes into correct alphabetic folder and looks for the exact account number (if patient's number is 112, and another patient is 1125, it might cause an issue otherwise)
If Macro finds the folder then it simply moves the file to the folder. If Macro doesn't find the folder then I want it to just place the folder in a "TO FILE" folder on my computer.
Macro then looks at the next PDF file, process is repeated.
I want to thank user LockeGarmin for helping me on this Macro. He got it to work perfectly at my home computer (Excel 2016), but my work computer is give me issues (either Excel 2010 or 2013, I believe it is 2013). I would think it would be a network issue (the folders are on different drives), however when in debug mode it looks like the paths are all fully recognized, as well as the file name that needs to be moved, so I'm wondering if it's a version issue?
Things don't get screwed up (again at work, not home) until around where the code states Set CustomerDirectly = FindCustomer[[SurnamePrefix, AccountNumber, CustomerDocumentsDirectly
It seems after this code, in debug mode) a lot of variables just start equally "Nothing" instead of a proper path or file. Even in the Function FindCustomerFolder(SurnamePrefix As String, AccountNumber As String, CustomerDocumentsDirect As Object) As Object pretty much everything equals "nothing", including Folder itself at that point.
When I do try to run the script I get an error around the For Each Folder in SurnameGroupFolder.SubFolders... etc.. the error states that I am missing a With block?
Here's the code, please help if you can. You can edit the code below or create your own if you feel you could make that'll work on an Excel 2013 working with network drives. Also, if the folders going alphabetically seems too difficult (like South, Adam #1115, file called SO1115.PDF going into Sm-Sz, then I can name the first half of files with only A and the second with only Z, if it's easier, so the above filed would be called SZ1115.PDF). Anyway, thanks for any help!
At my work I'm trying to use Excel VBA to take scanned PDF documents of patient information from the path they're scanned into and have a macro that will automatically go through the PDF files, look at the name of the files and be able to go to another path (patient accounts directly) and put said file into the correct patient folder.
Step-by-Step
Macro looks at the first PDF file in scanned folder
The PDF files will be named with two letters and up to six numbers. The letters represent the first two letters of the patient's last name, the number represents the account.
Macro looks at the two letters, goes to the patient accounts directly and determines the correct letter (folders are split as: Aa-Al, Am-Az, Ba-Bl, Bm-Bz, etc...)
Macro goes into correct alphabetic folder and looks for the exact account number (if patient's number is 112, and another patient is 1125, it might cause an issue otherwise)
If Macro finds the folder then it simply moves the file to the folder. If Macro doesn't find the folder then I want it to just place the folder in a "TO FILE" folder on my computer.
Macro then looks at the next PDF file, process is repeated.
I want to thank user LockeGarmin for helping me on this Macro. He got it to work perfectly at my home computer (Excel 2016), but my work computer is give me issues (either Excel 2010 or 2013, I believe it is 2013). I would think it would be a network issue (the folders are on different drives), however when in debug mode it looks like the paths are all fully recognized, as well as the file name that needs to be moved, so I'm wondering if it's a version issue?
Things don't get screwed up (again at work, not home) until around where the code states Set CustomerDirectly = FindCustomer[[SurnamePrefix, AccountNumber, CustomerDocumentsDirectly
It seems after this code, in debug mode) a lot of variables just start equally "Nothing" instead of a proper path or file. Even in the Function FindCustomerFolder(SurnamePrefix As String, AccountNumber As String, CustomerDocumentsDirect As Object) As Object pretty much everything equals "nothing", including Folder itself at that point.
When I do try to run the script I get an error around the For Each Folder in SurnameGroupFolder.SubFolders... etc.. the error states that I am missing a With block?
Here's the code, please help if you can. You can edit the code below or create your own if you feel you could make that'll work on an Excel 2013 working with network drives. Also, if the folders going alphabetically seems too difficult (like South, Adam #1115, file called SO1115.PDF going into Sm-Sz, then I can name the first half of files with only A and the second with only Z, if it's easier, so the above filed would be called SZ1115.PDF). Anyway, thanks for any help!
Code:
Option Explicit
Sub MoveFiles()
Dim Folder As Object
Dim File As Object
Const FolderPath As String = "C:\Users\MIS\Documents\MACRO TEST\ScannerDocs"
Set Folder = CreateObject("Scripting.FileSystemObject").GetFolder(FolderPath)
For Each File In Folder.Files
Call MoveCustomerDocument(File.Path)
Next File
End Sub
Sub MoveCustomerDocument(DocumentPath As String)
Const CustomerDocumentsDirectoryPath As String = "C:\Users\MIS\Documents\MACRO TEST\CustomerDocs"
Const NewCustomerDocumentsDirectoryPath As String = "C:\Users\MIS\Documents\MACRO TEST\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
, I'm going to email the code to my work email and try it out tomorrow. I'm at home now and, since the last test worked at home, but not at work, I don't really see a reason to try it at home now. Again, thanks and I'll keep you updated and whether or not I got it to work! If it works it would be a life saver!
