'FileDialog Object
'Provides file dialog box functionality similar to the functionality of the standard Open and Save dialog boxes found in Microsoft Office applications.
'Remarks
''
'Use the FileDialog property to return a FileDialog object. The FileDialog property is located in each individual Office application's Application object. The property takes a single argument, DialogType, that determines the type of FileDialog object that the property returns. There are four types of FileDialog object:
'
'Open dialog box - lets users select one or more files that you can then open in the host application using the Execute method.
'SaveAs dialog box - lets users select a single file that you can then save the current file as using the Execute method.
'File Picker dialog box - lets users select one or more files. The file paths that the user selects are captured in the FileDialogSelectedItems collection.
'Folder Picker dialog box - lets users select a path. The path that the user selects is captured in the FileDialogSelectedItems collection.
'Each host application can only create a single instance of the FileDialog object. Therefore, many of the properties of the FileDialog object persist even when you create multiple FileDialog objects. Therefore, make sure that you set all of the properties appropriately for your purpose before you display the dialog box.
''
'Example
''
'To display a file dialog box using the FileDialog object, you must use the Show method. Once a dialog box is displayed, no code executes until the user dismisses the dialog box. The following example creates and displays a File Picker dialog box and then displays each selected file in a message box.
'
Option Explicit
'File Dialog box to OPEN a file
Sub OpenAFile()
Dim fd As FileDialog
Dim ChooseAFile As Boolean
Set fd = Application.FileDialog(msoFileDialogOpen)
With fd
.Title = "Choose file from the list"
.AllowMultiSelect = False
.InitialFileName = Environ("UserProfile") & "\Desktop"
.ButtonName = "Open/Go!!"
.Filters.Clear
.Filters.Add " Any Excel Files", "*.xl*"
.Filters.Add " Old Excel Files", "*.xls"
.Filters.Add " New Excel Files", "*.xlsx"
.Filters.Add " Macro Enabled Excel Files", "*.xlsm"
.FilterIndex = 3
End With
ChooseAFile = fd.Show
If Not ChooseAFile Then
MsgBox "You didn't choose a file!"
Else
fd.Execute
End If
Set fd = Nothing
End Sub
'File Dialog box to SAVE a file
Sub SaveAFile()
Dim fd As FileDialog
Set fd = Application.FileDialog(msoFileDialogSaveAs)
With fd
.Title = "Save File"
.InitialFileName = Environ("UserProfile") & "\Desktop\" _
& ThisWorkbook.Name
.FilterIndex = 1
.Show
.Execute
End With
End Sub
'Procedure to choose FOLDER and FILE to copy
Sub PickAFile()
Dim fd As FileDialog
Dim copyfilepath As String
Dim counter As Integer
Dim choosenfile As Boolean
Dim folderpath As String
'pick up the folder
Set fd = Application.FileDialog(msoFileDialogFolderPicker)
With fd
.Title = "Choose folder to copy files with in"
.AllowMultiSelect = False
.InitialFileName = Environ("UserProfile") & "\Desktop"
End With
choosenfile = fd.Show
If Not choosenfile Then
MsgBox "You didn't choose folder"
Exit Sub
Else
folderpath = fd.SelectedItems(1)
End If
'choose files to copy
Set fd = Application.FileDialog(msoFileDialogFilePicker)
With fd
.Title = "Choose multiple file to Copy"
.AllowMultiSelect = True
.InitialFileName = Environ("UserProfile") & "\Desktop"
End With
choosenfile = fd.Show
If Not choosenfile Then
MsgBox "You didn't choose file"
Exit Sub
Else
For counter = 1 To fd.SelectedItems.Count
copyfilepath = fd.SelectedItems(counter)
Call CreateCopyofFile(copyfilepath, folderpath)
Next
End If
End Sub
'Refernce procedure to copy files in choosen foder/destination
Sub CreateCopyofFile(copyfilepath As String, folderpath As String)
Dim fso As Scripting.FileSystemObject
Dim fl As File
Set fso = New Scripting.FileSystemObject
Set fl = fso.GetFile(copyfilepath)
fso.CopyFile copyfilepath, folderpath & "\" & fl.Name
End Sub
'Provides file dialog box functionality similar to the functionality of the standard Open and Save dialog boxes found in Microsoft Office applications.
'Remarks
''
'Use the FileDialog property to return a FileDialog object. The FileDialog property is located in each individual Office application's Application object. The property takes a single argument, DialogType, that determines the type of FileDialog object that the property returns. There are four types of FileDialog object:
'
'Open dialog box - lets users select one or more files that you can then open in the host application using the Execute method.
'SaveAs dialog box - lets users select a single file that you can then save the current file as using the Execute method.
'File Picker dialog box - lets users select one or more files. The file paths that the user selects are captured in the FileDialogSelectedItems collection.
'Folder Picker dialog box - lets users select a path. The path that the user selects is captured in the FileDialogSelectedItems collection.
'Each host application can only create a single instance of the FileDialog object. Therefore, many of the properties of the FileDialog object persist even when you create multiple FileDialog objects. Therefore, make sure that you set all of the properties appropriately for your purpose before you display the dialog box.
''
'Example
''
'To display a file dialog box using the FileDialog object, you must use the Show method. Once a dialog box is displayed, no code executes until the user dismisses the dialog box. The following example creates and displays a File Picker dialog box and then displays each selected file in a message box.
'
Option Explicit
'File Dialog box to OPEN a file
Sub OpenAFile()
Dim fd As FileDialog
Dim ChooseAFile As Boolean
Set fd = Application.FileDialog(msoFileDialogOpen)
With fd
.Title = "Choose file from the list"
.AllowMultiSelect = False
.InitialFileName = Environ("UserProfile") & "\Desktop"
.ButtonName = "Open/Go!!"
.Filters.Clear
.Filters.Add " Any Excel Files", "*.xl*"
.Filters.Add " Old Excel Files", "*.xls"
.Filters.Add " New Excel Files", "*.xlsx"
.Filters.Add " Macro Enabled Excel Files", "*.xlsm"
.FilterIndex = 3
End With
ChooseAFile = fd.Show
If Not ChooseAFile Then
MsgBox "You didn't choose a file!"
Else
fd.Execute
End If
Set fd = Nothing
End Sub
'File Dialog box to SAVE a file
Sub SaveAFile()
Dim fd As FileDialog
Set fd = Application.FileDialog(msoFileDialogSaveAs)
With fd
.Title = "Save File"
.InitialFileName = Environ("UserProfile") & "\Desktop\" _
& ThisWorkbook.Name
.FilterIndex = 1
.Show
.Execute
End With
End Sub
'Procedure to choose FOLDER and FILE to copy
Sub PickAFile()
Dim fd As FileDialog
Dim copyfilepath As String
Dim counter As Integer
Dim choosenfile As Boolean
Dim folderpath As String
'pick up the folder
Set fd = Application.FileDialog(msoFileDialogFolderPicker)
With fd
.Title = "Choose folder to copy files with in"
.AllowMultiSelect = False
.InitialFileName = Environ("UserProfile") & "\Desktop"
End With
choosenfile = fd.Show
If Not choosenfile Then
MsgBox "You didn't choose folder"
Exit Sub
Else
folderpath = fd.SelectedItems(1)
End If
'choose files to copy
Set fd = Application.FileDialog(msoFileDialogFilePicker)
With fd
.Title = "Choose multiple file to Copy"
.AllowMultiSelect = True
.InitialFileName = Environ("UserProfile") & "\Desktop"
End With
choosenfile = fd.Show
If Not choosenfile Then
MsgBox "You didn't choose file"
Exit Sub
Else
For counter = 1 To fd.SelectedItems.Count
copyfilepath = fd.SelectedItems(counter)
Call CreateCopyofFile(copyfilepath, folderpath)
Next
End If
End Sub
'Refernce procedure to copy files in choosen foder/destination
Sub CreateCopyofFile(copyfilepath As String, folderpath As String)
Dim fso As Scripting.FileSystemObject
Dim fl As File
Set fso = New Scripting.FileSystemObject
Set fl = fso.GetFile(copyfilepath)
fso.CopyFile copyfilepath, folderpath & "\" & fl.Name
End Sub
No comments:
Post a Comment