VBA pick a file from a specific location? - vba

I'm attempting to put together some code in VBA where it will open a specific folder, let me choose the file then continue running my code.
Currently what I have (below) "works" in that it will open a folder but usually it starts from a generic location (Desktop) but will not go the the specific folder location to let me open the file I want.
Dim Filename as String
filename = Application.GetOpenFilename(FileFilter:="Excel Files, *.xl*;*.xm*")
If filename <> False Then
Workbooks.Open filename:=filename
End If
I've also tried something like this:
Dim Directory as String
Dim Filename as String
Directory = "\\page\data\NFInventory\groups\CID\Retail Setting\Lago Retail Uploads\" & strBrand & "\" & strSeason & "\" & strPrefix & "\"
Filename = Dir(Directory & "*.xl*;*.xm*")
Workbooks.Open Filename:=Directory
But it doesn't do anything and I think I have everything right. Any help or push in the right direction would be greatly appreciated.
-Deke

This will start an Open Dialog at the specified location:
Sub openBeckJFolder()
With Application.FileDialog(msoFileDialogOpen)
.AllowMultiSelect = True
.Show
.InitialFileName = "C:\Users\beckj\"
End With
End Sub
The Microsoft document page doesn't really get into it, but FileDialog has several features such as the InitialFileName that I used here.
_
UPDATE: To open the workbook
Code added that allows you to highlight the workbook & click Open, or double-click on the workbook to open it.
Sub openBeckJFolder()
Dim Filename As String
With Application.FileDialog(msoFileDialogOpen)
.AllowMultiSelect = False
.InitialFileName = "C:\Users\beckj\"
If .Show = True Then
Filename = .SelectedItems(1)
End If
End With
Workbooks.Open (Filename)
End Sub

Related

Convert .txt file to .xlsx & remove unneeded rows & format columns correctly

I've got a folder which contains .txt files (they contain PHI, so I can't upload the .txt file, or an example without PHI, or even any images of it). I need an excel macro, which will allow the user to choose the folder containing the file, and will then insert the .txt file data into a new excel workbook, format the rows and columns appropriately, and finally save the file to the same folder that the source was found in.
So far I've got all of that working except for the formatting of rows and columns. As of now, the .txt data is inserted to a new workbook & worksheet, but I can't seem to figure out how to get rid of rows I don't need, or how to get the columns formatted appropriately.
Again, I can't upload the .txt file (or anything) because the Healthcare organization I work for blocks it - even if I've removed all PHI.
Below is the macro I've created so far:
Private Sub CommandButton2_Click()
On Error GoTo err
'Allow the user to choose the FOLDER where the TEXT file(s) are located
'The resulting EXCEL file will be saved in the same location
Dim FldrPath As String
Dim fldr As FileDialog
Dim fldrChosen As Integer
Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
With fldr
.Title = "Select a Folder containing the Text File(s)"
.AllowMultiSelect = False
.InitialFileName = "\\FILELOCATION"
fldrChosen = .Show
If fldrChosen <> -1 Then
MsgBox "You Chose to Cancel"
Else
FldrPath = .SelectedItems(1)
End If
End With
If FldrPath <> "" Then
'Make a new workbook
Dim newWorkbook As Workbook
Set newWorkbook = Workbooks.Add
'Make worksheet1 of new workbook active
newWorkbook.Worksheets(1).Activate
'Completed files are saved in the chosen source file folder
Dim CurrentFile As String: CurrentFile = Dir(FldrPath & "\" & "*.txt")
Dim strLine() As String
Dim LineIndex As Long
Application.ScreenUpdating = False
Application.DisplayAlerts = False
While CurrentFile <> vbNullString
'How many rows to place in Excel ABOVE the data we are inserting
LineIndex = 0
Close #1
Open FldrPath & "\" & CurrentFile For Input As #1
While Not EOF(1)
'Adds number of rows below the inserted row of data
LineIndex = LineIndex + 1
ReDim Preserve strLine(1 To LineIndex)
Line Input #1, strLine(LineIndex)
Wend
Close #1
With ActiveSheet.Range("A1").Resize(LineIndex, 1)
.Value = WorksheetFunction.Transpose(strLine)
.TextToColumns Other:=True, OtherChar:="|"
End With
ActiveSheet.UsedRange.EntireColumn.AutoFit
ActiveSheet.Name = Replace(CurrentFile, ".txt", "")
ActiveWorkbook.SaveAs FldrPath & "\" & Replace(CurrentFile, ".txt", ".xls"), xlNormal
ActiveWorkbook.Close
CurrentFile = Dir
Wend
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End If
Done:
Exit Sub
err:
MsgBox "The following ERROR Occurred:" & vbNewLine & err.Description
ActiveWorkbook.Close
End Sub
Any ideas of how I can delete entire lines from being brought into excel?
And how I can format the columns appropriately? So that I'm not getting 3 columns from the .txt file all jammed into 1 column in the resulting excel file?
Thanks
I'd recommend you not to re-invent the wheel. Microsoft provides an excellent add-on to accomplish this task, Power Query.
It lets you to load every file in a folder and process it in bulks.
Here you have a brief introduction of what can do for you.

VBA Excel FileDialog to set/reset filters

I have a macro that asks a user to choose multiple files for data analysis. User selects a Excel or CSV file first (XLSX, XLS, CSV), then asks for a second file but CSV only. The intent of the tool is to combine the two data files into one.
In one Sub, I ask the user to select any compatible XLSX, XLS, or CSV files using the FileDialog code:
Dim myObj As Object
Dim myDirString As String
Set myObj = Application.FileDialog(msoFileDialogFilePicker)
With myObj
.InitialFileName = "C:\Users\" & Environ$("Username") & "\Desktop"
.Filters.Add "Custom Excel Files", "*.xlsx, *.csv, *.xls"
.FilterIndex = 1
If .Show = False Then MsgBox "Please select Excel file.", vbExclamation: Exit Sub
myDirString = .SelectedItems(1)
End With
It seems to filter appropriately:
After this data analysis in complete, then the user runs a second sub to select another file, but it must be a CSV file only. So I use this code to request CSV:
Dim yourObj3 As Object
Dim yourDirString3 As String
Set yourObj3 = Application.FileDialog(msoFileDialogFilePicker)
With yourObj3
.InitialFileName = "C:\Users\" & Environ$("Username") & "\Desktop"
.Filters.Add "CSV Files", "*.csv"
.FilterIndex = 1
If .Show = False Then MsgBox "Please select CSV file.", vbExclamation: Exit Sub
yourDirString3 = .SelectedItems(1)
End With
The problem is the FileDialog box remembers the first filter (Custom XLS) and they need to click the drop down to see the appropriate filter for CSV only...
So this would certainly be confusing to the user...I'm guessing I need to "clear" our that first filter after the user completes the first macro. Any suggestions on that code to clear (or reset) the first filter?
Tried adding this below it when I found what I thought was a similar question FileDialog persists previous filters:
With .Filters
.Clear
End With
But results in Compile error: Invalid or unqualified reference
This works in my environment. The only thing I made differently was to declare dialogs as FileDialog instead of Object.
Sub Test()
Dim myObj As FileDialog
Dim myDirString As String
Set myObj = Application.FileDialog(msoFileDialogFilePicker)
With myObj
.InitialFileName = "C:\Users\" & Environ$("Username") & "\Desktop"
.Filters.Clear
.Filters.Add "Custom Excel Files", "*.xlsx, *.csv, *.xls"
.FilterIndex = 1
.Show
End With
Dim yourObj3 As FileDialog
Dim yourDirString3 As String
Set yourObj3 = Application.FileDialog(msoFileDialogFilePicker)
With yourObj3
.InitialFileName = "C:\Users\" & Environ$("Username") & "\Desktop"
.Filters.Clear
.Filters.Add "CSV Files", "*.csv"
.FilterIndex = 1
.Show
End With
End Sub
Although it is not directly the answer to the specific msoFileDialogFilePicker from the OP (and googled this answer), I had the same problem with the msoFileDialogSaveAs dialog in Excel 2010 where errors are raised trying to modify the filters in any way because it obviously is not supported :-/
The msoFileDialogSaveAs dialog does NOT support file filters

Open save window in file path from cell and populate filename from cell

I need a simple code that will open the save window in a file location from a cell and also populate the file name from a cell, leaving the save window open so you can edit the path or filename before you click save if need be
I'm using this code but it only populates the filename
Application.Dialogs(xlDialogSaveAs).Show Range("A3").Text & "- (Submittal)" & ".xlsx"
I would like it to also open the save window in a file path from cell "A2"
Also i don't know if it matters but this will be ran on a workbook that has never been saved before
This will get filename from Cell A1 and Path from Cell A2 both on Sheet(1). Ensure that the path is in the format C:\Users\name\ remembering to ensure there is a backslash \ after the path.
Sub SaveAs()
Dim fPth As Object
Dim Path As String
Path = Sheets(1).Range("A2").Text
fileName = Sheets(1).Range("A1").Text
Set fPth = Application.FileDialog(msoFileDialogSaveAs)
With fPth
.InitialFileName = Path & fileName & ".xlsx"
.Title = "Save your File"
.InitialView = msoFileDialogViewList
.Show
End With
End Sub

Substitute Application.Getopenfilename with automation

I am looking to convert the code below to one where user is not required to select the files .
This code is to select a specific sheet from all the workbooks in the specific folder say" C:\Test"
This is a part of a consolidation macro
sub open_issues_sheet()
Dim Files as Variant
Files = Application.GetopenFilename("Excel FIles (*xl*),*xl*",Title:="Select Files", Multiselect:=True)
For Z = LBound(Files) To UBound(Files)
tem=Split(Files(Z),"\")
If(tem(UBound(tem)) <> ThisWorbook.Name) Then
Set S= Workbooks.Open(Files(Z))
S.Sheets("Issues").Select
'code to copy to current sheet
I tried using this http://spreadsheetpage.com/index.php/tip/getting_a_list_of_file_names_using_vba/
but I was getting a "Type Mismatch" Error at the Line "For Z =LBound"
Assuming that you still need the user to pick the folder containing the files that need to be consolidated, using the FileDialog(msoFileDialogFolderPicker) would be acceptable solution.
Dim sFilePath As String
With Application.FileDialog(msoFileDialogFolderPicker)
.AllowMultiSelect = False
.Title = "Select folder to consolidate"
If .Show = -1 Then
'Get the first file listed in the folder
sFilePath = Dir(.SelectedItems(1) & "\")
Do While Not sFilePath Like vbNullString
'Verify the extension before opening file
If Mid$(sFilePath, InStrRev(sFilePath, ".")) Like ".xls" Then
' Perform task ...
End If
'Get next file
sFilePath = Dir
Loop
End If
End With

How to open a file directory when only know part of the file name

Ok so I am trying to quickly open a file path using 2 cell values, everything works fine if I know the information verbatim. My issue is on the last value I will only have the first part of the file name, I have tried using the wildcard * but can't seem to get it to work. Keep getting "Path not found error". The second value is a project name, however, the folders also contain a description of the project. For example I know the project name is TB1756_2156 but the folder is named "TB1756_2156 Project Description Person in Charge January 2014" this is the code I have so far:
Sub Button2_Click()
ChDrive "S:\"
ChDir "S:\CLIENTS " & Range("B10").Value & "\Client1\" & Range("B11").Value & "*\Sample"
strFile = Application.GetOpenFilename
End Sub
EDIT:
Ok so if I where to manually open the file I want to examine this would be my path: S:\CLIENTS YEAR\FOLDER NAME\Project # Description Project Lead Year\Sample\File I want.xls
The vba I want open the dialog box and goes to the S:\CLIENTS then adds value from cell B10 then continues to FOLDER NAME\ then grabs just the Project # from cell B11 as this is all you would have handy , then would fill in the missing information, then continue to \Sample where the user would then select the file they want to open.
So manipulating the code provide by #dcromley this is what I got:
Sub UseFileDialogOpen()
With Application.FileDialog(msoFileDialogOpen)
.AllowMultiSelect = True
.InitialFileName = "S:\CLIENTS " & Range("C10").Value & "\FOLDER NAME\ & Range("C11").Value
.Show
End With
End Sub
My issue with this is that it only enters the Project # into the File Name: but does not actually open it. So looking for a way to parse the directory as I have it already from my original code minus the "*\Sample" and that it would open the only folder that starts with the Project #
If you have the first part of the file name and want the filename, this will do it.
If you want a directoryname, change vbNormal to vbDirectory.
Sub Main()
MsgBox FindFilename("abc", "Z:\untitled\")
End Sub
Function FindFilename$(FirstPart$, DirWhere$)
Dim sw1&, Filename$
Do
If sw1 = 0 Then
sw1 = 1
Filename = Dir$(DirWhere, vbNormal)
Else
Filename = Dir$()
End If
If Filename = "" Then Exit Do
If FirstPart = Left$(Filename, Len(FirstPart)) Then
FindFilename = Filename
Exit Function
End If
Loop
MsgBox "Error - Filename not found"
End Function
EDIT:
From the Excel 2003 help (you have the complete (initial) dirname now, right?):
Sub UseFileDialogOpen()
Dim lngCount&
With Application.FileDialog(msoFileDialogOpen)
.AllowMultiSelect = True
.InitialFileName = "Z:\untitled\"
.Show
For lngCount = 1 To .SelectedItems.Count
MsgBox .SelectedItems(lngCount)
Next lngCount
End With
End Sub
EDIT2: To open a *.xls file:
Sub Openxls()
Dim filename$
filename = "z:\untitled\dave1.xls"
Workbooks.Open filename
End Sub
I think dcromley's approach is sound but let us simplify things a little bit.
Dim prjDir As String, prjName As String
Dim initialFile As String, myDirString As String
'~~> B11 contains part of the foldername
'~~> B10 value as is
prjDir = "C:\CLIENTS\" & Range("B10") & "\Client1\" & Range("B11") & "*"
prjDir = Dir(prjDir, vbDirectory) '~~> use Dir to get the actual folder name
prjName = "C:\CLIENTS\" & Range("B10") & "\Client1\" & prjDir & "\*SAMPLE*.xls"
prjName = Dir(prjName, vbNormal) 'use Dir to get the actual filename
initialFile = "C:\CLIENTS\" & Range("B10") & "\Client1\" & prjDir & "\" & prjName
With Application.FileDialog(msoFileDialogFilePicker)
.Filters.Add "Excel Files", "*.xls"
.FilterIndex = 1
.InitialFileName = initialFile
.AllowMultiSelect = False
If .Show = False Then MsgBox "Please select Excel file.", vbExclamation: Exit Sub
myDirString = .SelectedItems(1)
.Filters.Clear
End With
Workbooks.Open myDirString '~~> Open the file
Is this close to what you want to achieve?
Btw, I assumed your Project # is unique.