Using VBA to open files in a folder using partial file names

[ESmith3187]

I found the code below but it is not working.

I am trying to find a code that will find a file utilizing where only the first two characters in the file name are know.
This is in Excel 2010. My file names will always be AA_MMM_YYYY.xlsx, BB_MMM_YYYY, CC_MMM_YYYY where the "MMM" changes
each month to the current month.

I found the following code but it is not working. Any insight is appreciated.

Sub OpenFiles()
Dim MyFolder As String
Dim MyFile As String
MyFolder = "C:\Users\JohnDoe\Desktop\2017"
MyFile = Dir(MyFolder & "\*.xlsx")
Do While MyFile <> ""
    Workbooks.Open Filename:=MyFolder & "" & MyFile
    MyFile = Dir
Loop
End Sub

 

[Trebor76]

Hi ESmith3187,

Welcome to MrExcel!!

See how this goes:

Option Explicit
Sub OpenFiles()
    
    Dim MyFolder As String
    Dim MyFile As String
    
    MyFolder = "C:\Users\JohnDoe\Desktop\2017\" 'EXACT folder name containing the files. Change to suit, but don't forget the trailing backslash '\'
    MyFile = Dir(MyFolder & "\*.xlsx")
    
    Do Until MyFile = ""
        Workbooks.Open Filename:=MyFolder & "" & MyFile
        MyFile = Dir
    Loop
    
End Sub

Note that from Excel 2007 there are several more workbook types than an Excel (Macro free) workbook i.e. xlsx extension that the above code will only open.

Regards,

Robert

 

[ESmith3187]

Robert, thanks! I do see where I entered my code in the wrong format here, so will ensure I fix that. But I appreciate your reply. I will test it in the morning at work, and will reply here on how it goes. And the files I will be opening are .xlsx.

 

[Trebor76]

Sounds good. Thanks for like btw

 

[ESmith3187]

Sounds good. Thanks for like btw

You're welcome, and the code works well. I modified it to search for partial filename, so it meets the need perfectly.

Sub AAonly()
    Dim MyFolder As String, ThisMonth As String
    Dim MyFile As String
    ThisMonth = Format(Date, "mmmm")
    MyFolder = "H:\Folder\2017\" & ThisMonth & "\"
    MyFile = Dir(MyFolder & "\AA*.xlsx")
    Do Until MyFile = ""
        Workbooks.Open Filename:=MyFolder & "" & MyFile
        MyFile = Dir
        
    Call AA_XXXX_Template
    Loop
End Sub

[\CODE]

 

[Jojo Dthird]

I have a similar issue but I need the VBA to go through a list of partial subfolder names and copy all the PDF files from each subfolder and copy in one folder

 

[TAJSanderson]

I have a similar issue but I need the VBA to go through a list of partial subfolder names and copy all the PDF files from each subfolder and copy in one folder

Hi - Did you manage to sort your request? I want to do the same thing.

 

[Trebor76]

Hi Jojo Dthird and TAJSanderson,

Once a thread has been solved it's best to start a new one with a link back to the original thread if you think it will help. That said, try this (note it won't work if you're using Citrix):

Option Explicit
Sub Macro1()

    Dim strInitialFolder As String, strPasteFilesPath As String
    
    strInitialFolder = "C:\MS_Office\Excel" '<< Starting directory to look for the PDF's. Change to suit. Can also be a reference to a worksheet cell.
    strInitialFolder = IIf(Right(strInitialFolder, 1) <> "\", strInitialFolder & "\", strInitialFolder)
    
    strPasteFilesPath = "C:\My PDF's\" '<< Directory to paste any found PDF's. Change to suit. Can also be a reference to a worksheet cell.
    strPasteFilesPath = IIf(Right(strPasteFilesPath, 1) <> "\", strPasteFilesPath & "\", strPasteFilesPath)
    
    Call CopyFiles(strInitialFolder, strPasteFilesPath, True) 'True to include looping through sub folders of the 'strInitialFolder' path, else False for just the 'strInitialFolder' path.
               
    MsgBox "PDF files have now been copied into:" & vbNewLine & """" & strPasteFilesPath & """", vbInformation
    
End Sub
Sub CopyFiles(strInitialFolderName As String, strPastePath As String, blnIncludeSubfolders As Boolean)

    Dim objFSO As Object
    Dim varSourceFolder As Variant, varFullPath As Variant, varSubFolder As Variant

    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set varSourceFolder = objFSO.GetFolder(strInitialFolderName)
    
    For Each varFullPath In varSourceFolder.Files
        If StrConv(objFSO.GetExtensionName(varFullPath), vbLowerCase) = "pdf" Then
            Call objFSO.CopyFile(CStr(varFullPath), CStr(strPastePath & objFSO.GetFileName(varFullPath)), True)
        End If
    Next varFullPath
    
    If blnIncludeSubfolders = True Then
        For Each varSubFolder In varSourceFolder.SubFolders
            Call CopyFiles(varSubFolder.Path, strPastePath, True)
        Next varSubFolder
    End If
    
    Set varFullPath = Nothing
    Set varSourceFolder = Nothing
    Set objFSO = Nothing
    
End Sub

Regards,

Robert

 

[Trebor76]

Here's another way that doesn't use FileSystemObject so should work in a Citrix environment too:

Option Explicit
Sub Macro2()

    'Adapted from http://www.vbaexpress.com/forum/showthread.php?t=42813
   
On Error GoTo ErrCatch

    Dim strInitialDir As String, strPasteDir As String
    Dim strMyFiles() As String
    Dim lngLoopCounter As Long
   
    strInitialDir = "C:\MS_Office\Excel"  '<< Initial directory. Change to suit. Can also be a reference to a worksheet cell.
    strPasteDir = "C:\My PDF's\" '<< Directory to paste any found PDF's. Change to suit. Can also be a reference to a worksheet cell.
   
    strInitialDir = IIf(Right(strInitialDir, 1) <> "\", strInitialDir & "\", strInitialDir)
    strInitialDir = strInitialDir & "*.pdf"
    strPasteDir = IIf(Right(strPasteDir, 1) <> "\", strPasteDir & "\", strPasteDir)
   
    strMyFiles = Split(CreateObject("wscript.shell").exec("cmd /c Dir " & strInitialDir & " /b /s").stdout.readall, vbCrLf)
   
    If UBound(strMyFiles) = 0 Then
        MsgBox "There were no PDF files found from the start directory to copy.", vbExclamation
        Exit Sub
    Else
        For lngLoopCounter = LBound(strMyFiles) To UBound(strMyFiles) - 1
            FileCopy strMyFiles(lngLoopCounter), strPasteDir & Dir(strMyFiles(lngLoopCounter))
        Next lngLoopCounter
    End If
   
    MsgBox "PDF files have now been copied into:" & vbNewLine & """" & strPasteDir & """", vbInformation
   
    Exit Sub
   
ErrCatch:
   
    MsgBox "There was a problem copying one or all of the PDF files." & vbNewLine & "Details are:" & vbNewLine & Err.Number & ". " & Err.Description, vbCritical

End Sub