I am trying to have an user select a file and choose a to upload to another location ( like a shared drive). I am using the name function but I realized I am having trouble getting the file name and put into the "toPath" since it is up to the user. Below is my completed code and please any advice or suggestions would help.
At the same time, I hope my codes may help someone is trying to do the samething. Thanks
To Pick a file to upload:
Private Sub Command2_Click()
Dim fDialog As Variant
' Clear listbox contents. '
Me.Path1.Value = ""
' Set up the File Dialog. '
Set fDialog = Application.FileDialog(msoFileDialogFilePicker)
With fDialog
' Allow user to make multiple selections in dialog box '
.AllowMultiSelect = False
' Set the title of the dialog box. '
.Title = "Please select one file"
' Clear out the current filters, and add our own.'
.Filters.Clear
.Filters.Add "All Files", "*.*"
' Show the dialog box. If the .Show method returns True, the '
' user picked at least one file. If the .Show method returns '
' False, the user clicked Cancel. '
If .Show = True Then
'add selected path to text box
Me.Path1.Value = .SelectedItems(1)
Else
MsgBox "No File Selected."
End If
End With
End Sub
To Pick a upload path to upload the file:
Private Sub Command10_Click()
Dim FromPath As String
Dim ToPath As String
Dim fDialog2 As Variant
' Clear listbox contents. '
Me.Path2.Value = ""
FromPath = Me.Path1
ToPath = Me.Path2
' Set up the File Dialog. '
Set fDialog2 = Application.FileDialog(msoFileDialogFolderPicker)
With fDialog2
If .Show = True Then
'add selected path to text box
Me.Path2.Value = .SelectedItems(1)
Else
MsgBox "No file uploaded."
End If
End With
Name FromPath As ToPath & "\" & 'ummmmmmmmmmm I am stucked :(
MsgBox "You can find the files and subfolders from " & FromPath & " in " & ToPath
End Sub
Refactor the end of Command10_Click as shown below. User can pick new file name.
....
End With
Dim ToName as String
ToName = InputBox("Please Enter New File Name","New File Name")
Name FromPath As ToPath & "\" & ToName
....
I am not sure which file types you are relocating, but you can grab the extension type from FromPath and add to end of ToName
Related
I have a lot of files in one folder. What I want to do is add a column with the name of the file. I found a solution to this, but I want to optimize. Currently I am just adding the values from J2 to J1000 to make sure I cover all rows. This is not ideal as the amount of rows in each file differ. What I want to do is find a way to add the value matching the amount of rows that exists in the sheet.
I want to find a way to check if there is data in column A for each row and then add the value as long as there is some data in column A for each row.
My thoughts would be to do a while statement to check if each row in column A is different from an empty string and add the value as long as it is different from an empty string. However I am not sure how to implement this.
Here is my code:
Sub AllWorkbooks()
Dim MyFolder As String 'Path collected from the folder picker dialog
Dim MyFile As String 'Filename obtained by DIR function
Dim wbk As Workbook 'Used to loop through each workbook
On Error Resume Next
Application.ScreenUpdating = False
'Opens the folder picker dialog to allow user selection
With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "Please select a folder"
.Show
.AllowMultiSelect = False
If .SelectedItems.Count = 0 Then 'If no folder is selected, abort
MsgBox "You did not select a folder"
Exit Sub
End If
MyFolder = .SelectedItems(1) & "\" 'Assign selected folder to MyFolder
End With
MyFile = Dir(MyFolder) 'DIR gets the first file of the folder
'Loop through all files in a folder until DIR cannot find anymore
Do While MyFile <> ""
'Opens the file and assigns to the wbk variable for future use
Set wbk = Workbooks.Open(FileName:=MyFolder & MyFile)
'Replace the line below with the statements you would want your macro to perform
Sheets(1).Range("j1").Value = "Date"
Sheets(1).Range("j2:j1000").Value = Mid(ActiveWorkbook.Name, 10, 10)
wbk.Close savechanges:=True
MyFile = Dir 'DIR gets the next file in the folder
Loop
Application.ScreenUpdating = True
End Sub
I am having difficulty figuring out how to put the Folder Path in Cell C49. I'd like to have the Path there for the User to understand where they are searching and if they have to change said Path.
I got this VBA code from,
http://learnexcelmacro.com/wp/2016/12/how-to-open-file-explorer-in-vba/
Private Sub cmd_button_BROWSEforFolder_Click()
On Error GoTo err
Dim fileExplorer As FileDialog
Set fileExplorer = Application.FileDialog(msoFileDialogFolderPicker)
'To allow or disable to multi select
fileExplorer.AllowMultiSelect = False
With fileExplorer
If .Show = -1 Then 'Any folder is selected
[folderPath] = .SelectedItems.Item(1)
ThisWorkbook.Sheets("Home").Range("C49") = .SelectedItems.Item(1)
Else ' else dialog is cancelled
MsgBox "You have cancelled the dialogue"
[folderPath] = "" ' when cancelled set blank as file path.
End If
End With
err:
Exit Sub
End Sub
I've tried rearranging the location of,
ThisWorkbook.Sheets("Home").Range("C49") = .SelectedItems.Item(1)
and tried changing
.SelectedItems.Item(1)
to,
[folderPath]
with no prevail.
what am I missing?
all I need is the path to be displayed above the txtbox and if it needs to be changed then the User used the button to redirect the search. (this button will not initiate the search Macro)
Private Sub cmd_button_BROWSEforFolder_Click()
On Error GoTo err
Dim fileExplorer As FileDialog
Set fileExplorer = Application.FileDialog(msoFileDialogFolderPicker)
Dim folderPath As String
'To allow or disable to multi select
fileExplorer.AllowMultiSelect = False
With fileExplorer
If .Show = -1 Then 'Any folder is selected
folderPath = .SelectedItems.Item(1)
Else ' else dialog is cancelled
MsgBox "You have cancelled the dialogue"
folderPath = "NONE" ' when cancelled set blank as file path.
End If
End With
err:
ThisWorkbook.Sheets("Home").Range("C49") = folderPath
End Sub
Im new to Access and VBA.
I created a form in which i can select a file via fileDialog.
Here the code for the fileDialog:
Public Function DateiAuswaehlen()
Dim objFiledialog As FileDialog
Set objFiledialog = _
Application.FileDialog(msoFileDialogOpen)
With objFiledialog
.AllowMultiSelect = False
If .Show = True Then
DateiAuswaehlen = .SelectedItems(1)
End If
End With
Set objFiledialog = Nothing
End Function
How can I import the selected Excel File into an access table?
I found the DoCmd.TransferSpreadsheet Method but it has not worked, tbh i dont even know where to place it. Im sorry as I mentioned im very new to VBA
Here you go!!
Sub btn_GetFileName_Click()
'************************************************************************
'Lets get the file name
Debug.Print "Getting File Name"
'Declare a variable as a FileDialog object.
Dim fd As FileDialog
'Set the starting look location
Dim strComPath As String
strComPath = "C:\"
Dim strFilePath As String
'Create a FileDialog object as a File Picker dialog box.
Set fd = Application.FileDialog(msoFileDialogFilePicker)
'Declare a variable to contain the path
'of each selected item. Even though the path is a String,
'the variable must be a Variant because For Each...Next
'routines only work with Variants and Objects.
Dim vrtSelectedItem As Variant
'Use a With...End With block to reference the FileDialog object.
With fd
.InitialFileName = strComPath
.AllowMultiSelect = False
.Filters.Clear
'Add filter to only show excel files.
.Filters.Add "Excel files", "*.xlsm", 1
'Use the Show method to display the File Picker dialog box and return the user's action.
'The user pressed the action button.
If .Show = -1 Then
strFilePath = .SelectedItems(1)
'Step through each string in the FileDialogSelectedItems collection.
'For Each vrtSelectedItem In .SelectedItems
'vrtSelectedItem is a String that contains the path of each selected item.
'You can use any file I/O functions that you want to work with this path.
'This example simply displays the path in a message box.
' strFilePath: " & vrtSelectedItem
'Next vrtSelectedItem
Else
'The user pressed Cancel.
DoCmd.Hourglass (False)
MsgBox "You must select a file to import before proceeding", vbOKOnly + vbExclamation, "No file Selected, exiting"
Set fd = Nothing
Exit Sub
End If
End With
tblFileName = strFilePath
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, "tblTest", tblFileName, True
Set fd = Nothing
End Sub
I'm looking to open multiple Excel files and run the same macro (contained in each) on each file.
For example, I'd like to automatically open every file in h:\dbs and execute the CmdUpdate_Click macro within each file.
How might I go about this?
Try something like this. I expect you can research how to open the Visual Basic Editor and figure out where to paste this.
'Declare variables
Dim FolderObj, FSO, FileObj As Object
Dim FolderDialog As FileDialog
'Create and run dialog box object
Set FolderDialog = Application.FileDialog(msoFileDialogFolderPicker)
With FolderDialog
.ButtonName = "Select"
.AllowMultiSelect = False
.InitialFileName = "B:\BIM Projects\"
.InitialView = msoFileDialogViewDetails
'Check if user canceled dialog box
'Exit if yes
If .Show = -1 Then
MsgBox "No Folder Selected"
Exit Sub
End If
End With
'Check if user canceled dialog box
'Exit if yes
'Create a File System Object to be the folder that was selected
Set FSO = CreateObject("scripting.filesystemobject")
Set FolderObj = FSO.getfolder(FolderLocation)
'For each obj in the selected folder
For Each FileObj In FolderObj.Files
'Test if the file extension contains "xl" and make sure it's an Excel file before opening
If InStr(1, Right(FileObj.Name, Len(FileObj.Name) - InStr(1, FileObj.Name, ".")), "xl") = 1 Then
'Prevent the workbook from displaying
ActiveWindow.Visible = False
'Open the Workbook
Workbooks.Open (FolderObj & "\" & FileObj.Name)
'Run the Macro
Application.Run "'" & FolderObj & "\" & FileObj.Name & "'!CmdUpdate_Click"
'Save the Workbook
Workbooks(FileObj.Name).Save
'Close the Workbook
Workbooks(FileObj.Name.Close
End If
'Turn this back on
ActiveWindow.Visible = True
Next
I will caution you that this is based on some code I wrote for Word, so there are no guarantees it will work and I don't have time to test it. It will, however, give you a very good start if it doesn't.
Edit to Add: You may
I need the browse button in input box to find file - VB A - EXCEL Macro][1]
need to find the folder path via browse button instead of typing in input box
is it possible?
|-------------------|
|-------------------| Browse
by clicking a cell it should ask for file browse.
should not be edited manually. i mean , i want to lock the particular cell locked. and only able to edit via macro.
Alternately:
Sub tgr()
Dim strFilePath As String
strFilePath = Application.GetOpenFilename
If strFilePath = "False" Then Exit Sub 'Pressed cancel
MsgBox strFilePath
End Sub
You can use this to find a file. Modify the filter if you need to. the variable fldr will have your data. Then you can set your textbox to that value.
Sub File_Picker()
With Application.FileDialog(msoFileDialogFilePicker)
.Filters.Clear
.Filters.Add "Text", "*.txt", 1
.InitialFileName = ActiveWorkbook.Path & "\"
.Show
If .SelectedItems.Count = 0 Then GoTo 1
fldr = .SelectedItems(1)
End With
End Sub
or:
Sub Folder_Picker()
With Application.FileDialog(msoFileDialogFolderPicker)
.InitialFileName = ActiveWorkbook.Path & "\"
.Show
If .SelectedItems.Count = 0 Then GoTo 1
fldr = .SelectedItems(1)
End With
End Sub
I have more helpful pieces of code like this at My GitHub