GetOpenFilename Default Location to Downloads - excel

I don't see any parameter in GetOpenFilename to set default folder to Downloads.
Currently, it opens Documents folder. Is it possible to make the default location as Downloads folder.
I can't hardcode the path as Downloads without including the Username.
e.g C:\Users\NameOfUser\Downloads
**********Solution**********
Dim FilePaths As FileDialogSelectedItems
Dim iFolderPath As String
iFolderPath = Environ("USERPROFILE") _
& Application.PathSeparator & "Downloads" & Application.PathSeparator
With Application.FileDialog(msoFileDialogFilePicker)
.AllowMultiSelect = True
.Filters.Clear
.Filters.Add "Open CSV", "*.csv"
.InitialFileName = iFolderPath
If .Show <> -1 Then
Do
ans = MsgBox("No file selected. Cannot continue.", 53, "Try again")
If ans = 2 Then Exit Do
With Application.FileDialog(msoFileDialogFilePicker)
.AllowMultiSelect = True
.Filters.Clear
.Filters.Add "Open CSV", "*.csv"
.InitialFileName = iFolderPath
.Show
End With
Loop
If ans = 2 Then MsgBox "No file selected. User cancelled.", vbInformation, "Special"
Exit Sub
End If
Set FilePaths = .SelectedItems
End With
Dim FilePath As Variant
For Each FilePath In FilePaths
Workbooks.Open FilePath
Next FilePath

Choose Files to Open (FileDialog)
Here is a different way that uses the FileDialog object.
Use the Environ function to build the initial path.
Sub ChooseFilesToOpen()
Dim iFolderPath As String: iFolderPath = Environ("USERPROFILE") _
& Application.PathSeparator & "Downloads" & Application.PathSeparator
Dim FilePaths As FileDialogSelectedItems
With Application.FileDialog(msoFileDialogFilePicker)
.AllowMultiSelect = True
.Filters.Clear
.Filters.Add "Excel Workbook", "*.xlsx"
.InitialFileName = iFolderPath
If .Show <> -1 Then
MsgBox "Canceled.", vbExclamation
Exit Sub
End If
Set FilePaths = .SelectedItems
End With
Dim FilePath As Variant
For Each FilePath In FilePaths
Debug.Print FilePath
Next FilePath
End Sub

Related

How to search for latest file in folder and if not found then open dialog box with restrictions?

The goal is to combine two functions or make them compatible with each other. There is errors when it comes to the part when the path of the chosen file is not refer to in the same manner as the path of the found file within the loop if available in the folder.
I get an error. See "HERE IS WHERE I GET THE ERROR" at
Dim closedBook As Workbook: Set closedBook = Workbooks.Open(sFilePath)
'main code that run is doing something like search for file within folder,
'loop and get the latest file and generates a path and name for next
'function which is to copy a sheet from the found file over to the main
'workbook and so.
'What I'm trying to to is to build a failsafe, lets say file is not pushed
'or placed whin this predestinated folder, then instead of doing nothing,
'dialog box opens up and files gets chosen instead.
Option Explicit
Sub ImportAndFormatData()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Const sFolderPath As String = "C:\Temp\"
'Search for newest file
Dim sFileName As String: sFileName = Dir(sFolderPath & "_pr11*.xlsx")
If Len(sFileName) = 0 Then Call OpenDialogBox
Dim cuDate As Date, sFileDate As Date, cuPath As String, sFilePath As String
Do Until Len(sFileName) = 0
cuPath = sFolderPath & sFileName
cuDate = FileDateTime(cuPath)
'Debug.Print "Current: " & cuDate & " " & cuPath ' print current
If cuDate > sFileDate Then
sFileDate = cuDate
sFilePath = cuPath
End If
sFileName = Dir
Loop
'Debug.Print "Result: " & sFileDate & " " & sFilePath ' print result
'Open newest file - HERE IS WHERE I GET THE ERROR
Dim closedBook As Workbook: Set closedBook = Workbooks.Open(sFilePath)
closedBook.Sheets("Analyse").Copy After:=ThisWorkbook.Sheets("PR11_P3")
closedBook.Close SaveChanges:=False
'code dose not end here but that part don't need to be included here since
'its just formatting
End Sub
In OpenDialogBox, I'm tying to enforce a specific title (only this file/report is correct source for the entire code or rather rest of the code).
See "GIVES ERROR DOSENT WORK" at
.Filters.Add "Excel filer", "_pr11*.xlsx?", 1
Sub OpenDialogBox()
Dim fd As Office.FileDialog
Set fd = Application.FileDialog(msoFileDialogFilePicker)
With fd
.Filters.Clear
.Title = "Välj valfri PR11"
.Filters.Add "Excel filer", "_pr11*.xlsx?", 1 'GIVES ERROR DOSENT WORK
.AllowMultiSelect = False
If .Show = True Then
Debug.Print .SelectedItems(1)
Debug.Print Dir(.SelectedItems(1))
End If
End With
End Sub
This combines both the Dir() and FileDialog approaches:
Sub ImportAndFormatData()
Dim fSelected As String, wb As Workbook
fSelected = InputFile()
If Len(fSelected) > 0 Then
Set wb = Workbooks.Open(fSelected)
wb.Sheets("Analyse").Copy After:=ThisWorkbook.Sheets("PR11_P3")
wb.Close False
End If
End Sub
Function InputFile() As String
Const SRC_FOLDER As String = "C:\Temp\"
Dim f, fSelected As String, latestDate As Date, fdt
f = Dir(SRC_FOLDER & "*_pr11*.xlsx") 'first check the configured folder for a match
If Len(f) > 0 Then
'found matching file at specified path: loop for the newest file
Do While Len(f) > 0
fdt = FileDateTime(SRC_FOLDER & f)
If fdt > latestDate Then
fSelected = SRC_FOLDER & f
latestDate = fdt
End If
f = Dir()
Loop
InputFile = fSelected
Else
'no match at specified path - allow user selection
With Application.FileDialog(msoFileDialogFilePicker)
.Filters.Clear
.Title = "Välj valfri PR11"
.Filters.Add "Excel filer", "*.xlsx" 'filter only allows extension: no filename wildcards...
.AllowMultiSelect = False
If .Show Then InputFile = .SelectedItems(1)
End With
End If
End Function

Converting multiple xlsl files to xls (97-2003 Worksheet) extension without changing the names

I am trying to loop through all the 'xlsx' files in a folder and convert them to 'xls' ( Excel 97-2003 Worksheet) format. I use the following codes but then the output files are still saved as 'xlsx' instead of 'xls'. I am a beginner and looking to learn more from others. Thanks for your help!
Sub Convert()
Dim strPath As String
Dim strFile As String
Dim strfilenew As String
Dim xWbk As Workbook
Dim xSFD, xRFD As FileDialog
Dim xSPath As String
Dim xRPath As String
Set xSFD = Application.FileDialog(msoFileDialogFolderPicker)
With xSFD
.Title = "Please select the folder contains the xls files:"
.InitialFileName = "C:\"
End With
If xSFD.Show <> -1 Then Exit Sub
xSPath = xSFD.SelectedItems.Item(1)
Set xRFD = Application.FileDialog(msoFileDialogFolderPicker)
With xRFD
.Title = "Please select a folder for outputting the new files:"
.InitialFileName = "C:\"
End With
If xRFD.Show <> -1 Then Exit Sub
xRPath = xRFD.SelectedItems.Item(1) & "\"
strPath = xSPath & "\"
strFile = Dir(strPath & "*.xlsx")
strfilenew = Dir(strPath & "*.xls")
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Do While strFile <> ""
If Right(strFile, 4) = "xlsx" Then
Set xWbk = Workbooks.Open(Filename:=strPath & strfilenew)
xWbk.SaveAs Filename:=xRPath & strfilenew, _
FileFormat:=xlExcel18
xWbk.Close SaveChanges:=True
End If
strFile = Dir
Loop
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
There was a bit of a mix-up in your file naming, basically as evidenced by the several double-declarations that I removed. The really big mistake was here, Set xWbk = Workbooks.Open(Filename:=strPath & strfilenew) where you tried to open the old workbook by the new name. I think the confusion started here "Please select the folder contains the xls files:". Of course, this is the folder with the XLSX files. The recommended antidote is to use "meaningful" variable names but you chose to speak in riddles (like xSFD) which makes coding more difficult.
However, the code below is largely yours, and it does work.
Sub Convert()
' 230
Dim Spath As String ' path to read from (XLSX files)
Dim Rpath As String ' path to write to (XLS files)
Dim strFile As String ' loop variable: current file name
Dim Wbk As Workbook ' loop object: current workbook(strFile)
Dim Sp() As String ' split array of strFile
Dim strFileNew As String
With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "Please select the folder contains the XLSX files:"
.InitialFileName = "C:\"
If .Show <> -1 Then Exit Sub
Spath = .SelectedItems.Item(1) & "\"
End With
With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "Please select a folder for outputting the new files:"
.InitialFileName = "C:\"
If .Show <> -1 Then Exit Sub
Rpath = .SelectedItems.Item(1) & "\"
End With
With Application
.ScreenUpdating = False
.DisplayAlerts = False
End With
strFile = Dir(Spath & "*.xlsx")
Do While strFile <> ""
If Right(strFile, 4) = "xlsx" Then
Sp = Split(strFile, ".")
Sp(UBound(Sp)) = "xls"
strFileNew = Join(Sp, ".")
Set Wbk = Workbooks.Open(Filename:=Spath & strFile)
Wbk.SaveAs Filename:=Rpath & strFileNew, FileFormat:=xlExcel8
Wbk.Close SaveChanges:=True
End If
strFile = Dir
Loop
With Application
.ScreenUpdating = True
.DisplayAlerts = True
End With
End Sub
Observe that the new file name is created by splitting the old name on periods, changing the last element, and reassembling the modified array.

Save file as csv, keeps coming up as .xlsx

I am trying to output a copy of a workbook as a CSV File. I have the code below but on saving it comes up in file type as Excel workbook.
Sub SAVE_CSV()
Dim FileName As String
FileName = "CSV Import File"
Dim fPth As Object
Set fPth = Application.FileDialog(msoFileDialogSaveAs)
With fPth
.InitialFileName = FileName
.Title = "Save Your Import File"
.InitialView = msoFileDialogViewList
If .Show <> 0 Then
ThisWorkbook.SaveAs FileName:=.SelectedItems(1) & "*.csv", FileFormat:=xlCSV
End If
End With
You know the name you want to save it as, so maybe it's just a case of selecting the right folder:
Sub SAVE_CSV()
Dim FileName As String
FileName = "CSV Import File Again"
Dim fPth As Object
Set fPth = Application.FileDialog(msoFileDialogFolderPicker)
With fPth
.InitialFileName = "C:\Users\Testing\Documents\Can be deleted\" 'Change as required.
.Title = "Save Your Import File"
.InitialView = msoFileDialogViewList
If .Show <> 0 Then
ThisWorkbook.SaveAs FileName:=.SelectedItems(1) & "\" & FileName & ".csv", FileFormat:=xlCSV
End If
End With
End Sub
Replace with:
ThisWorkbook.SaveAs FileName:=.SelectedItems(1) & ".csv"
Follow the below logic:
Path - Directory
"\"
File Name
File type - .csv

Bad file name or number vba

my code keeps getting a bad file name or number error and I can't figure out what the issue is, any help would be appreciated! I'm trying to store the filepath based on user selection as a variable which I can reference later in a vlookup. Below is my code, I can't figure out what's wrong but I used the pasted code in another macro which compiled fine.
sub edits
dim xpath and xfile as string
xPath = NewPath 'Newpath function executes
xfile = Dir$(xPath & "*.xlsm*", vbNormal) 'error here
Set SourceBook = Workbooks.Open(xPath & xfile)
End Sub
Function NewPath() As String
With Application.FileDialog(msoFileDialogOpen)
.ButtonName = "Choose a file"
.Title = "Previous File"
.AllowMultiSelect = False
If .Show Then xPath = .SelectedItems(1) & "\"
End With
End Function
Below is the code I've used which has compiled, it has the user select a folder instead of a file
sub something
dim xpath and xfile as string
xPath = NewPath
If Not strPath = vbNullString Then
xfile = Dir$(xPath & "*.xlsm", vbNormal)
Do While Not xfile = vbNullString
'some code
Set SourceBook = Workbooks.Open(xPath & xfile)
SourceBook.Close False
xfile = Dir$()
Loop
End If
End Sub
Function NewPath() As String
With Application.FileDialog(msoFileDialogFolderPicker)
.ButtonName = "Choose a folder"
.Title = "Folder Picker"
.AllowMultiSelect = False
If .Show Then NewPath = .SelectedItems(1) & "\"
End With
End Function

How to list files names in folder

I'm trying to create a list of file names in folder for reference, The following code is listing all the file names with extension Filename.pdf
how do I exclude the extension from file name? .pdf
Option Explicit
Sub GetFileName()
Dim xlRow As Long
Dim sDir As String
Dim FileName As String
Dim sFolder As String
sFolder = "C:\Temp\"
With Application.FileDialog(msoFileDialogFolderPicker)
.InitialFileName = Application.DefaultFilePath & "\"
.Title = "Please select a folder"
.InitialFileName = sFolder
.Show
If .SelectedItems.Count <> 0 Then
sDir = .SelectedItems(1) & "\"
FileName = Dir(sDir, 7)
Do While FileName <> ""
Range("A1").Offset(xlRow) = FileName
xlRow = xlRow + 1
FileName = Dir
Loop
End If
End With
End Sub
I'm not 100% sure what you are asking, but I think that
If FileName Like "*.pdf" Then
Range("A1").Offset(xlRow) = Mid(FileName,1,Len(FileName)-4)
End If
might be what you are after.
If the filename itself does not contain a period, you can use Split():
Option Explicit
Sub GetFileName()
Dim xlRow As Long
Dim sDir As String
Dim FileName As String
Dim sFolder As String
sFolder = "C:\Temp\"
With Application.FileDialog(msoFileDialogFolderPicker)
.InitialFileName = Application.DefaultFilePath & "\"
.Title = "Please select a folder"
.InitialFileName = sFolder
.Show
If .SelectedItems.Count <> 0 Then
sDir = .SelectedItems(1) & "\"
FileName = Dir(sDir, 7)
Do While FileName <> ""
Range("A1").Offset(xlRow) = Split(FileName, ".")(0)
xlRow = xlRow + 1
FileName = Dir
Loop
End If
End With
End Sub

Resources