Copy Files To Folder

mra2023

New Member
Joined
Jan 23, 2023
Messages
2
Office Version
  1. 2019
Platform
  1. Windows
Please, I have a file that creates a folder called "Electronic Library" in the same file path
Windows Explorer opens to display all files and all formats
Required
Copy any file to this folder with its original name and copy the name to the textbox
Thank you for your help

Private Sub CommandButton1_Click()
Dim strFolder As String
Dim GetFilePath As String
Dim FileSourcePath As String
Dim FileDestinationPath As String
strFolder = ThisWorkbook.Path & Application.PathSeparator & "Electronic Library"
If Dir(strFolder, vbDirectory) = "" Then
MkDir strFolder
End If

With Application.FileDialog(msoFileDialogFilePicker)
.AllowMultiSelect = False
.Filters.Add "Electronic Library", "*.????"
If .Show <> 0 Then
GetFilePath = .SelectedItems(1)
End If
End With
Me.TextBox1.Value = GetFilePath

FileSourcePath = Trim(GetFilePath)
FileDestinationPath = ThisWorkbook.Path & "\Electronic Library\" & "." & Split(FileSourcePath, ".")(UBound(Split(FileSourcePath, ".")))
FileCopy FileSourcePath, FileDestinationPath

End Sub
 
Hi @ mra2023!
So what was the essence of the question, no one understood from your description? Maybe this is how you need it?
Code:
Option Explicit

Private Sub CommandButton1_Click()
    Dim strFolder   As String
    Dim GetFilePath As String
    Dim FileSourcePath As String
    Dim FileDestinationPath As String
    strFolder = ThisWorkbook.Path & Application.PathSeparator & "Electronic Library"

    If Dir(strFolder, vbDirectory) = "" Then
        MkDir strFolder
    End If

    With Application.FileDialog(msoFileDialogFilePicker)
        .AllowMultiSelect = False
        .Filters.Add "All Files", "*.*"    ' We allow you to select files of any format

        If .Show <> 0 Then
            GetFilePath = .SelectedItems(1)
        Else
            Exit Sub    ' If no file is selected, exit the procedure.
        End If
    End With

    Me.TextBox1.Value = GetFilePath

    FileSourcePath = Trim(GetFilePath)
    FileDestinationPath = strFolder & Application.PathSeparator & Dir(FileSourcePath)    ' Save the file name

    ' Copy the file to the "Electronic Library" folder
    FileCopy FileSourcePath, FileDestinationPath
End Sub
Or
VBA Code:
Option Explicit

Private Sub CommandButton1_Click()
    Dim strFolder As String
    Dim GetFilePath As String
    Dim FileSourcePath As String
    Dim FileDestinationPath As String
    Dim FileName As String   ' Variable for file name without path

    strFolder = ThisWorkbook.Path & Application.PathSeparator & "Electronic Library"
    
    If Dir(strFolder, vbDirectory) = "" Then
        MkDir strFolder
    End If

    With Application.FileDialog(msoFileDialogFilePicker)
        .AllowMultiSelect = False
        .Filters.Add "All Files", "*.*"   ' We allow you to select files of any format
        
        If .Show <> 0 Then
            GetFilePath = .SelectedItems(1)
        Else
            Exit Sub   ' If no file is selected, exit the procedure
        End If
    End With
    
    FileSourcePath = Trim(GetFilePath)
    FileName = Dir(FileSourcePath) ' We get only the file name

    ' Display only the file name in TextBox1
    Me.TextBox1.Value = FileName

    ' Forming a path for copying
    FileDestinationPath = strFolder & Application.PathSeparator & FileName

    ' Copy the file to the "Electronic Library" folder
    FileCopy FileSourcePath, FileDestinationPath
End Sub
It is not clear.
 
Last edited:
Upvote 0

Forum statistics

Threads
1,226,883
Messages
6,193,492
Members
453,803
Latest member
hbvba

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