Copy Files From Folder Not All Characters

D

Dippy001

New Member
Joined
Mar 11, 2021
Messages
8
Platform
  1. Windows
Hi MrExcel Experts

I was wondering if you may be able to help me with a situation I am currently stuck with.

I require a VBA that looks into a folder location and sees if the file is there copies the data from the sheet and imports it into my active sheet without opening the file if it does not exist it throws an error message

The file name would be from the active sheet that it is looking for and also it it will be a partial file name for example

So from the drop down the file name is chosen

1697376654772.png


Then the macro would run and select the file from the folder location provided in the macro

1697376796666.png


The file then is selected from the folder ignoring all the other charachets at the end of the name

Name 1 is selected

1697376850818.png



then it copys the data from Name 1 15.10.2023 14.24 and pastes it excluding the headers into the main sheet with also the file name it copied it from

1697376942806.png



1697377097445.png


I hope this make sense and someone has the ability to help me in this perdicument, Thank you
 

Excel Facts

When they said...
When they said you are going to "Excel at life", they meant you "will be doing Excel your whole life".
Sort by date Sort by votes
Try this macro, after changing the folder path in the code.
VBA Code: 
Public Sub Import_Partial_File_Name_Workbook()
    
    Dim folder As String, matchFile As String, fileName As String
    Dim wb As Workbook
    
    folder = "C:\path\to\Test\"    'CHANGE THIS PATH
    
    If Right(folder, 1) <> "\" Then folder = folder & "\"
    
    With ActiveSheet
        matchFile = .Range("C6").Value & "*.xls*"
        fileName = Dir(folder & matchFile)
        If fileName <> vbNullString Then
            Application.ScreenUpdating = False
            Set wb = Workbooks.Open(folder & fileName)
            wb.Worksheets(1).UsedRange.Offset(1).Copy .Range("H7")
            wb.Close False
            .Range("D6").Value = Left(fileName, InStrRev(fileName, ".") - 1)
            Application.ScreenUpdating = True
        Else
            MsgBox "No files matching '" & matchFile & "' exist in " & folder, vbInformation
        End If
    End With

End Sub
 
Upvote 0
John_w said:
Try this macro, after changing the folder path in the code.
VBA Code: 
Public Sub Import_Partial_File_Name_Workbook()
   
    Dim folder As String, matchFile As String, fileName As String
    Dim wb As Workbook
   
    folder = "C:\path\to\Test\"    'CHANGE THIS PATH
   
    If Right(folder, 1) <> "\" Then folder = folder & "\"
   
    With ActiveSheet
        matchFile = .Range("C6").Value & "*.xls*"
        fileName = Dir(folder & matchFile)
        If fileName <> vbNullString Then
            Application.ScreenUpdating = False
            Set wb = Workbooks.Open(folder & fileName)
            wb.Worksheets(1).UsedRange.Offset(1).Copy .Range("H7")
            wb.Close False
            .Range("D6").Value = Left(fileName, InStrRev(fileName, ".") - 1)
            Application.ScreenUpdating = True
        Else
            MsgBox "No files matching '" & matchFile & "' exist in " & folder, vbInformation
        End If
    End With

End Sub
Click to expand...

Hi John_w

I have just tested the code and it works beautifully exactly what i needed spot on, thank you so much my friend i very much appreciate the help.

Thank you once again

Just one thing if there is 2 files named

Name 1 15.10.2023 11.05
Name 1 15.10.2023 14.05

How can I get it to pull only the latest file which would be

Name 1 15.10.2023 14.05
 
Upvote 0
Dippy001 said:
How can I get it to pull only the latest file
Click to expand...

VBA Code: 
Public Sub Import_Partial_File_Name_Latest_Workbook()
    
    Dim folder As String, matchFile As String, fileName As String, latestFileName As String
    Dim fileDate As Date, latestFileNameDate As Date
    Dim parts As Variant
    Dim wb As Workbook
    
    folder = "C:\path\to\Test\"    'CHANGE THIS PATH
    
    If Right(folder, 1) <> "\" Then folder = folder & "\"
    
    With ActiveSheet
        matchFile = .Range("C6").Value & "*.xls*"
        latestFileName = ""
        latestFileNameDate = 0
        fileName = Dir(folder & matchFile)
        While fileName <> vbNullString
            parts = Split(Left(fileName, InStrRev(fileName, ".") - 1), " ")
            If UBound(parts) >= 2 Then
                fileDate = CDate(Replace(parts(UBound(parts) - 1), ".", "/")) + TimeValue(parts(UBound(parts)))
                If fileDate > latestFileNameDate Then
                    latestFileName = fileName
                    latestFileNameDate = fileDate
                End If
            End If
            fileName = Dir
        Wend
        If latestFileName <> "" Then
            Application.ScreenUpdating = False
            Set wb = Workbooks.Open(folder & latestFileName)
            wb.Worksheets(1).UsedRange.Offset(1).Copy .Range("H7")
            wb.Close False
            .Range("D6").Value = Left(latestFileName, InStrRev(latestFileName, ".") - 1)
            Application.ScreenUpdating = True
        Else
            MsgBox "No files matching '" & matchFile & "' exist in " & folder, vbInformation
        End If
    End With

End Sub
 
Upvote 1
John_w said:
VBA Code: 
Public Sub Import_Partial_File_Name_Latest_Workbook()
   
    Dim folder As String, matchFile As String, fileName As String, latestFileName As String
    Dim fileDate As Date, latestFileNameDate As Date
    Dim parts As Variant
    Dim wb As Workbook
   
    folder = "C:\path\to\Test\"    'CHANGE THIS PATH
   
    If Right(folder, 1) <> "\" Then folder = folder & "\"
   
    With ActiveSheet
        matchFile = .Range("C6").Value & "*.xls*"
        latestFileName = ""
        latestFileNameDate = 0
        fileName = Dir(folder & matchFile)
        While fileName <> vbNullString
            parts = Split(Left(fileName, InStrRev(fileName, ".") - 1), " ")
            If UBound(parts) >= 2 Then
                fileDate = CDate(Replace(parts(UBound(parts) - 1), ".", "/")) + TimeValue(parts(UBound(parts)))
                If fileDate > latestFileNameDate Then
                    latestFileName = fileName
                    latestFileNameDate = fileDate
                End If
            End If
            fileName = Dir
        Wend
        If latestFileName <> "" Then
            Application.ScreenUpdating = False
            Set wb = Workbooks.Open(folder & latestFileName)
            wb.Worksheets(1).UsedRange.Offset(1).Copy .Range("H7")
            wb.Close False
            .Range("D6").Value = Left(latestFileName, InStrRev(latestFileName, ".") - 1)
            Application.ScreenUpdating = True
        Else
            MsgBox "No files matching '" & matchFile & "' exist in " & folder, vbInformation
        End If
    End With

End Sub
Click to expand...
Hi

Is it possible to put the data in a specific sheet name e.g Sheet1 and then the file name to Sheet2?
 
Upvote 0
John_w said:
VBA Code: 
Public Sub Import_Partial_File_Name_Latest_Workbook()
   
    Dim folder As String, matchFile As String, fileName As String, latestFileName As String
    Dim fileDate As Date, latestFileNameDate As Date
    Dim parts As Variant
    Dim wb As Workbook
   
    folder = "C:\path\to\Test\"    'CHANGE THIS PATH
   
    If Right(folder, 1) <> "\" Then folder = folder & "\"
   
    With ActiveSheet
        matchFile = .Range("C6").Value & "*.xls*"
        latestFileName = ""
        latestFileNameDate = 0
        fileName = Dir(folder & matchFile)
        While fileName <> vbNullString
            parts = Split(Left(fileName, InStrRev(fileName, ".") - 1), " ")
            If UBound(parts) >= 2 Then
                fileDate = CDate(Replace(parts(UBound(parts) - 1), ".", "/")) + TimeValue(parts(UBound(parts)))
                If fileDate > latestFileNameDate Then
                    latestFileName = fileName
                    latestFileNameDate = fileDate
                End If
            End If
            fileName = Dir
        Wend
        If latestFileName <> "" Then
            Application.ScreenUpdating = False
            Set wb = Workbooks.Open(folder & latestFileName)
            wb.Worksheets(1).UsedRange.Offset(1).Copy .Range("H7")
            wb.Close False
            .Range("D6").Value = Left(latestFileName, InStrRev(latestFileName, ".") - 1)
            Application.ScreenUpdating = True
        Else
            MsgBox "No files matching '" & matchFile & "' exist in " & folder, vbInformation
        End If
    End With

End Sub
Click to expand...
Hi Jon

Hi

Is it possible to put the data in a specific sheet name e.g Sheet1 and then the file name to Sheet2?
 
Upvote 0
Dippy001 said:
Is it possible to put the data in a specific sheet name e.g Sheet1 and then the file name to Sheet2?
Click to expand...

If that's the only changes and the partial file name is still read from C6 on the active sheet:

VBA Code: 
wb.Worksheets(1).UsedRange.Offset(1).Copy ThisWorkbook.Worksheets("Sheet1").Range("H7")

and:

VBA Code: 
ThisWorkbook.Worksheets("Sheet2").Range("D6").Value = Left(latestFileName, InStrRev(latestFileName, ".") - 1)
 
Upvote 0
You must log in or register to reply here.

Similar threads

GMC The Macro Man
  • Solved
VBA Script - Return to named file
Replies
6
Views
127
mumps
mumps
M
  • Question
Macro - Merge all files into one sheet
Replies
2
Views
253
MountainFog
M
A
  • Solved
Copying files to a newly created folder named from data within spreadsheet
Replies
2
Views
219
AndyEd
A
T
  • Question
Loop through folder and copy data into master spreadsheet
Replies
2
Views
281
TaskMaster
T
J
  • Question
VBA to clear all date in columns A2 to AC in the destination file, then copy the data from the same columns from all files in a folder
Replies
1
Views
102
jdhfch
J

Forum statistics

Threads
1,215,071
Messages
6,122,964
Members
449,094
Latest member
Anshu121

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