Solved How to copy a file when closing a File Dialog? (1 Viewer)

Y

YuvalH

New member
Local time
Today, 03:12
Joined
Jan 21, 2022
Messages
13
I want to copy a selected file to a folder and I think a good time for it is when I'm closing the File Dialog. How do I do this?

File Dialog entry and exit:
Code: 
Private Sub File_Dialog_Click()
    Dim fd As FileDialog
    Dim varFile As Variant
 
 
    Set fDialog = Application.FileDialog(msoFileDialogFilePicker)
 
    With fDialog
        .AllowMultiSelect = False
        .Title = "Please select one or more files"
      
        .Filters.Clear
        .Filters.Add "All Files", "*.*"
      
        If .Show = True Then
            For Each varFile In .SelectedItems
                Me.File.Value = .SelectedItems.Item(1)
            Next
        Else
            MsgBox "You clicked Cancel in the file dialog box."
        End If
    End With
End Sub

Private Sub File_Dialog_Exit(Cancel As Integer)
    Me.File_Name = Mid([File], InStrRev([File], "\") + 1, InStrRev([File], ".") - InStrRev([File], "\") - 1)
    Me.File_Type = Right([File], Len([File]) - InStrRev([File], "."))
End Sub

Destiny folder:
Code: 
Public Sub Create_Folder(sFolder As String)
    If Len(Dir(sFolder, vbDirectory)) = 0 Then
        MkDir sFolder
    End If
End Sub

Public Sub FolderCheck()
    Create_Folder ("E:\" & Format(Date, "yyyy"))
    Create_Folder ("E:\" & Format(Date, "yyyy") & "\" & Format(Date, "mm") & " " & Format(Date, "mmmm"))
End Sub

thx for help
 
Last edited:
June7

June7

AWF VIP
Local time
Yesterday, 16:12
Joined
Mar 9, 2014
Messages
5,466
Can use FileCopy() or CopyFile() methods.
 
Last edited:
The_Doc_Man

The_Doc_Man

Immoderate Moderator
Staff member
Local time
Yesterday, 19:12
Joined
Feb 28, 2001
Messages
27,147
In your file dialog click routine, after the End With but before you do the Exit Sub, you could do a file copy in either of the ways as suggested by June7. However, I'm not sure what you were doing with that loop dealing with Me.File.Value, so I'm going to back away a little before giving any more advice.

It also looks like you have code trying to extract file name and file type, which is a reasonable thing to ask. However, if you look up the FileSystemObject (FSO), which you get from the Windows Scripting library, you would find that there are routines that extract the file name and type for you without such complex expressions. Having FSO present also lets you manipulate, copy, delete, and examine the properties of files. May I therefore respectfully suggest you take a look at the FileSystemObject?

docs.microsoft.com

FileSystemObject object

Office VBA reference topic
docs.microsoft.com

If you start from the linked page and just explore a little, you will find all of the wonderful file-related things you can do with FSO.
 
Eugene-LS

Eugene-LS

Registered User.
Local time
Today, 03:12
Joined
Dec 7, 2018
Messages
481
YuvalH said:
I want to copy a selected file to a folder and I think a good time for it is when I'm closing the File Dialog. How do I do this?
...
Click to expand...
Try that code please:
Code: 
Private Sub File_Dialog_Click()
Const scDistDiskPart$ = "E:"
Dim sFilePathAndName$, sFileName$, sFileExt$
Dim sFileDistPath$, sVal$
Dim objFSO As Object  ' File System Object
'----------------------------------------------------------------------------------------------
On Error GoTo File_Dialog_Click_Err

    With Application.FileDialog(1) '1 = msoFileDialogOpen
        .Title = "Please select one or more files" 'Window title
        .InitialFileName = CurrentProject.Path     'Starting path
        .AllowMultiSelect = False                  'There cannot be multiple files - Only ONE!
        .Filters.Clear
        .Filters.Add "All Files", "*.*", 1
        'Ïîåõàëè!
        .Show
        If .SelectedItems.Count > 0 Then
            sFilePathAndName = .SelectedItems(1)
        Else
            MsgBox "You clicked Cancel in the File Open dialog box."
            Exit Sub
        End If
    End With

    sFileName = Mid(sFilePathAndName, InStrRev(sFilePathAndName, "\") + 1,  _
            InStrRev(sFilePathAndName, ".") - InStrRev(sFilePathAndName, "\") - 1)
    sFileExt = Right(sFilePathAndName, Len(sFilePathAndName) - InStrRev(sFilePathAndName, "."))
    'Debug.Print sFileName & "." & sFileExt

    Set objFSO = CreateObject("Scripting.FileSystemObject")

'Creating folders:
    sFileDistPath = scDistDiskPart & "\" & Format(Date, "yyyy")
    If Dir(sFileDistPath, vbDirectory) = "" Then objFSO.CreateFolder sFileDistPath
  
    sFileDistPath = sFileDistPath & "\" & Format(Date, "mm")
    If Dir(sFileDistPath, vbDirectory) = "" Then objFSO.CreateFolder sFileDistPath

    sFileDistPath = sFileDistPath & "\" & Format(Date, "mmmm")
    If Dir(sFileDistPath, vbDirectory) = "" Then objFSO.CreateFolder sFileDistPath
  
    DoEvents
    'Debug.Print sFileDistPath
  
'Copying:
    sVal = sFileDistPath & "\" & sFileName & "." & sFileExt
    objFSO.CopyFile sFilePathAndName, sVal
    DoEvents
  
    If Not Dir(sVal) = "" Then
        MsgBox "Copying completed successfully!", vbInformation
    Else
       GoTo File_Dialog_Click_End
    End If
  
'Filling up form fields:
'    Me.File_Name = sFileName
'    Me.File_Type = sFileExt

File_Dialog_Click_End:
    On Error Resume Next
    Set objFSO = Nothing
    Err.Clear
    Exit Sub

File_Dialog_Click_Err:
    MsgBox "Error " & Err.Number & " (" & Err.Description & ") in Sub" & _
           "File_Dialog_Click - 00_Tests.", vbCritical, "Ïðîèçîøëà îøèáêà!"
    Err.Clear
    Resume File_Dialog_Click_End
End Sub
 
Y

YuvalH

New member
Local time
Today, 03:12
Joined
Jan 21, 2022
Messages
13
The_Doc_Man said:
In your file dialog click routine, after the End With but before you do the Exit Sub, you could do a file copy in either of the ways as suggested by June7. However, I'm not sure what you were doing with that loop dealing with Me.File.Value, so I'm going to back away a little before giving any more advice.

It also looks like you have code trying to extract file name and file type, which is a reasonable thing to ask. However, if you look up the FileSystemObject (FSO), which you get from the Windows Scripting library, you would find that there are routines that extract the file name and type for you without such complex expressions. Having FSO present also lets you manipulate, copy, delete, and examine the properties of files. May I therefore respectfully suggest you take a look at the FileSystemObject?

docs.microsoft.com

FileSystemObject object

Office VBA reference topic
docs.microsoft.com

If you start from the linked page and just explore a little, you will find all of the wonderful file-related things you can do with FSO.
Click to expand...
The 'Me.File.Value' takes the path and enters him into a field called "File" in a table.
 
Y

YuvalH

New member
Local time
Today, 03:12
Joined
Jan 21, 2022
Messages
13
Eugene-LS said:
Try that code please:
Code: 
Private Sub File_Dialog_Click()
Const scDistDiskPart$ = "E:"
Dim sFilePathAndName$, sFileName$, sFileExt$
Dim sFileDistPath$, sVal$
Dim objFSO As Object  ' File System Object
'----------------------------------------------------------------------------------------------
On Error GoTo File_Dialog_Click_Err

    With Application.FileDialog(1) '1 = msoFileDialogOpen
        .Title = "Please select one or more files" 'Window title
        .InitialFileName = CurrentProject.Path     'Starting path
        .AllowMultiSelect = False                  'There cannot be multiple files - Only ONE!
        .Filters.Clear
        .Filters.Add "All Files", "*.*", 1
        'Ïîåõàëè!
        .Show
        If .SelectedItems.Count > 0 Then
            sFilePathAndName = .SelectedItems(1)
        Else
            MsgBox "You clicked Cancel in the File Open dialog box."
            Exit Sub
        End If
    End With

    sFileName = Mid(sFilePathAndName, InStrRev(sFilePathAndName, "\") + 1,  _
            InStrRev(sFilePathAndName, ".") - InStrRev(sFilePathAndName, "\") - 1)
    sFileExt = Right(sFilePathAndName, Len(sFilePathAndName) - InStrRev(sFilePathAndName, "."))
    'Debug.Print sFileName & "." & sFileExt

    Set objFSO = CreateObject("Scripting.FileSystemObject")

'Creating folders:
    sFileDistPath = scDistDiskPart & "\" & Format(Date, "yyyy")
    If Dir(sFileDistPath, vbDirectory) = "" Then objFSO.CreateFolder sFileDistPath
 
    sFileDistPath = sFileDistPath & "\" & Format(Date, "mm")
    If Dir(sFileDistPath, vbDirectory) = "" Then objFSO.CreateFolder sFileDistPath

    sFileDistPath = sFileDistPath & "\" & Format(Date, "mmmm")
    If Dir(sFileDistPath, vbDirectory) = "" Then objFSO.CreateFolder sFileDistPath
 
    DoEvents
    'Debug.Print sFileDistPath
 
'Copying:
    sVal = sFileDistPath & "\" & sFileName & "." & sFileExt
    objFSO.CopyFile sFilePathAndName, sVal
    DoEvents
 
    If Not Dir(sVal) = "" Then
        MsgBox "Copying completed successfully!", vbInformation
    Else
       GoTo File_Dialog_Click_End
    End If
 
'Filling up form fields:
'    Me.File_Name = sFileName
'    Me.File_Type = sFileExt

File_Dialog_Click_End:
    On Error Resume Next
    Set objFSO = Nothing
    Err.Clear
    Exit Sub

File_Dialog_Click_Err:
    MsgBox "Error " & Err.Number & " (" & Err.Description & ") in Sub" & _
           "File_Dialog_Click - 00_Tests.", vbCritical, "Ïðîèçîøëà îøèáêà!"
    Err.Clear
    Resume File_Dialog_Click_End
End Sub
Click to expand...
Thank you very much, it worked!
 
You must log in or register to reply here.

Similar threads

Y
How do I use a function on a button?
Replies
5
Views
586
YuvalH
Y
G
Help with AfterUpdate event to add Outlook Attachment to Hyperlink field
Replies
8
Views
596
Uncle Gizmo
Uncle Gizmo
T
Solved Append table to excel file
Replies
8
Views
796
ebs17
E
mike60smart
Choose a Folder
2
Replies
32
Views
1,560
jdraw
jdraw
A
Data not importing from .xlsx file
Replies
3
Views
1,047
arnelgp
arnelgp

Users who are viewing this thread

Total: 1 (members: 0, guests: 1)
Top Bottom