VBA Excel File Open Prompt Cancel Error - excel

So I am using a file open prompt to gather a filename.
I then open this file in a background instance, parse information to a dictionary and close the file.
This works fine.
The code for this is:
Application.FileDialog(msoFileDialogOpen).Show
sFullName = Application.FileDialog(msoFileDialogOpen).SelectedItems(1)
If the user presses cancel, which is obviously a feasible scenario, I get the following error:
Invalid procedure call or argument
I have tried to change the 'gather' line to:
If Application.FileDialog(msoFileDialogOpen).SelectedItems(1) Then sFullName = Application.FileDialog(msoFileDialogOpen).SelectedItems(1)
However this still brings up the error. Even disabling alerts brings up an error or '400'.
Any help on how to make this popup or handle it would be greatly appreciated.

You need check the bounds to determine if anything was selected
with Application.FileDialog(msoFileDialogOpen)
.Show
if (.SelectedItems.Count = 0) Then
'// dialog dismissed with no selection
else
sFullName = .SelectedItems(1)
end if
end with

You could use GetSaveAsFilenamei.e.
Dim strFileName As String
strFileName = Application.GetSaveAsFilename
If strFileName = "False" Then MsgBox "User cancelled"

Related

Error 91 when opening file Workbooks.Open(Filepath)

I'm facing a problem that I really don't understand.
I created a macro that opens a workbooks, reads some information in it, and closes it.
To open the workbook, I use these lines:
Path = Func_Use_File_DialogOpen()
If Path <> "" Then
Set wb_chosen = Application.Workbooks.Open(Path, UpdateLinks:=0)
ElseIf Path = "" Then
MsgBox ("Error, start again")
Exit Sub
End If
For your information, the variable Path contains the whole path of the file, with the extension.
Example: Path= C:\Users\alex\Desktop\file.xlsm
On my computer, the macro works perfectly, it opens the worbook, and I can use it with my variable called wb_chosen
But when I send my macro to a coworker, he gets the error
"RUNTIME ERROR 91: Object variable or With Block variable not set"
How is that possible? when I try to debug the macro on his computer, I see that the variable path is perfectly fine (like on my computer), but the variable wb_chosen is nothing
so the problem is on the line :
Set wb_chosen = Application.Workbooks.Open(Path, UpdateLinks:=0)
Could it be the Application.Workbooks that doesn't work?
I really need this macro to work on every computer, is there a parameter to change on Excel? should I just put this instead?
Workbooks.Open(Path)
FYI, here are some other details about the code
The workbook is declared like this
Public wb_chosen As Workbook
the function Func_Use_File_DialogOpen() is as follow:
Public Function Func_Use_File_DialogOpen() As String
On Error GoTo lblErr
With Application.FileDialog(msoFileDialogFilePicker)
.AllowMultiSelect = False
.Show
Func_Use_File_DialogOpen = .SelectedItems(1)
End With
Exit Function
lblErr:
MsgBox Err.Description, vbCritical, "Error"
Func_Use_File_DialogOpen = vbNullString
End Function
The variable Path is a string that store the full path of the file. When I run the code on my computer, i have
Path=\\cm\TA\PNL\10 - octobre\pnl_Octobre.xlsm

InitialFileName of FileDialog doesn't display whole file name

So, I'm opening a FileDialog from a workbook that lets the user choose and import files. I have a bit of logic that recommends a specific directory and file via .InitialFileName, depending on the criteria set by the user. This code handles the FileDialog:
With objFileDialog
.InitialFileName = strIFN 'This is the relevant line
.AllowMultiSelect = False
.ButtonName = "Select"
.Title = "Please select the file containing " & whichFile
If .Show > 0 Then
End If
If (.SelectedItems.Count > 0) Then
strPath = .SelectedItems(1)
End If
End With
strIFN contains the path of the recommended file, for example:
\\Company-Server\Users\Username\Desktop\Intern Unterlagen\Projektcontrolling\Testlauf\AK\201909_Company_Zeiteinträge_AK.xlsx
The path works fine, but in the opened FileDialog I see this:
As you can see, the file name is cut short by a weird scroll setting. The box does in fact contain the whole file name, but doesn't show it until you click into it and scroll to the left. As this confuses the user, I am trying to display the whole file name. I'd appreciate any tips on this.
As a bonus I would ideally want to already select the recommended file (having it highlighted in blue), but that is not essential for usability.
This appears to be the normal behavior, I can replicate it pretty easily in Excel 2016. While SendKeys is usually frowned upon, it seems to be useful for this case:
With objFileDialog
.InitialFileName = strIFN 'This is the relevant line
.AllowMultiSelect = False
.ButtonName = "Select"
.Title = "Please select the file containing " & whichFile
On Error Resume Next
SendKeys "{HOME}"
On Error GoTo 0
If .Show > 0 Then
strPath = .SelectedItems(1)
End If
End With
When the dialog is displayed, the text cursor is at the end of the filename, and the text box containing the filename has focus. So, this was a bit of a shot in the dark, but I figured that "{HOME}" ought to return the cursor to the beginning of the filename, just like it would if the user hit the HOME key with the dialog open.
Note: In my observation, it seems to make no difference whether you include Wait:=True to SendKeys.

Deploying Macros as Add Ins with Custom Ribbon Buttons to the entire office

I have been searching for a way to distribute macros to my tech illiterate office in the simplest way I can.
From my research, saving the Macros into a .xlam add-in would seem to be headed in the right direction.
Is it also possible to set up a custom ribbon tab in this manner?
Thus far I have failed to find any guides and our office security may also block certain avenues.
Edit:
Using W-Hit's excellent solution, and setting up the folder structure as indicated, it definitely helps make deploying an update much easier with the DeployAddIn subroutine.
I also found it useful to put the DeployAddIn and InstallAddin subroutines into a custom ribbon tab of their own!
I ran into a problem with the InstallAddin subroutine however: how to format the XML text in VBA without running into syntax errors.
I discovered that Each Element must have mso at the start e.g. <button> becomes <mso:button> and each "speech marked section" in a line must have ""double speech marks".
Perhaps the easiest way to use this install function is to save and edit the code into an active file, then open C:\Users[username]\AppData\Local\Microsoft\Office\Excel.officeUI in Notepad++. Then simply perform a find and replace to add in the extra quotation marks and paste it into the ribbonXML = "insert your text here" section of the code, ensuring it is encapsulated by the final speech marks to mark the entire section as a text string.
I might also look into adding extra functionality here... having an inputbox or userform that allows you to paste the code in at this point rather than have you enter the VBA editor to paste it in.
I currently do this, and it's a somewhat in depth process to setup, but runs smoothly once it is.
1st step is to create a folder structure with testing and production copies of your .xlam files that you are the admin for.
2nd, in the production folder, right click all .xlam files and set the attributes in the properties to Read-only. If you don't you'll never be able to update the addin if anyone else is in it.
3rd, when you make updates to the code in the testing file, just replace the production file with the updated file, and change to Read-only again. Users will only have to close all instances of excel and reopen to have the most up-to-date copy of the add-in.
Below is an admin add-in I use to move testing files to production.
Sub DeployAddIn()
'Author : Ken Puls (www.excelguru.ca)
'Macro Purpose: To deploy finished/updated add-in to a network
' location as a read only file
Dim strAddinDevelopmentPath As String
Dim strAddinPublicPath As String
Dim FSO As New FileSystemObject
'Set development path
ChDrive "R:"
ChDir "R:\addins\PROJECTS"
strAddinDevelopmentPath = Application.GetOpenFilename()
If strAddinDevelopmentPath = "False" Then
Exit Sub
ElseIf InStr(strAddinDevelopmentPath, "\PRODUCTION\") > 1 Then
If MsgBox("You've Selected a Production File To Replace a Production File. Would You Like To Continue Anyway?", vbYesNo) = vbNo Then
Exit Sub
End If
End If
'Get Desitination path
strAddinPublicPath = Replace(strAddinDevelopmentPath, "TESTING", "PRODUCTION")
'Create dir if it doesn't exist
On Error Resume Next
MkDir Left(strAddinPublicPath, InStrRev(strAddinPublicPath, "\") - 1)
On Error GoTo 0
'Turn off alert regarding overwriting existing files
Application.DisplayAlerts = False
'overwrite existing file
On Error Resume Next
SetAttr strAddinPublicPath, vbNormal
On Error GoTo 0
FSO.CopyFile strAddinDevelopmentPath, strAddinPublicPath, True
SetAttr strAddinPublicPath, vbReadOnly
'Resume alerts
Application.DisplayAlerts = True
End Sub
4th, I've also written a macro to change the custom ribbon. The below link, in addition Ron deBruin's site is useful. https://grishagin.com/vba/2017/01/11/automatic-excel-addin-installation.html
Code to automate addin install after you get the right text from the officeUI file
Sub InstallAddin()
'Adapted from https://grishagin.com/vba/2017/01/11/automatic-excel-addin-installation.html
Dim eai As Excel.AddIn
Dim alreadyinstalled As Boolean
Dim ribbonXML As String
'check if already installed
For Each eai In Application.AddIns
If eai.Name = "Main addin.xlam" Then
eai.Installed = False
Exit For
End If
Next
'add and install the addin
Set eai = Application.AddIns.Add("path to Main addin.xlam", False)
eai.Installed = True
'append quick access ribbon xml to add button
ClearCustRibbon
LoadNewRibbon
'have to close addin for it to load properly the first time
Workbooks("Main addin.xlam").Close
End Sub
Sub ClearCustRibbon()
'https://social.msdn.microsoft.com/Forums/vstudio/en-US/abddbdc1-7a24-4664-a6ff-170d787baa5b/qat-changes-lost-when-using-xml-to-modify-ribbon-excel-2016-2016?forum=exceldev
Dim hFile As Long
Dim ribbonXMLString As String
hFile = FreeFile
OfficeUIFilePath = Environ("USERPROFILE") & "\AppData\Local\Microsoft\Office\Excel.officeUI"
ribbonXMLString = "<mso:customUI xmlns:mso=""http://schemas.microsoft.com/office/2009/07/customui"">" & _
"<mso:ribbon>" & _
"<mso:qat>" & _
"<mso:sharedControls>" & _
"</mso:sharedControls>" & _
"</mso:qat>" & _
"</mso:ribbon>" & _
"</mso:customUI>"
Open OfficeUIFilePath For Output Access Write As hFile
Print #hFile, ribbonXMLString
Close hFile
End Sub
Sub LoadNewRibbon()
Dim hFile As Long
hFile = FreeFile
OfficeUIFilePath = Environ("USERPROFILE") & "\AppData\Local\Microsoft\Office\Excel.officeUI"
ribbonXML = "your ribbon text here"
Open OfficeUIFilePath For Output Access Write As hFile
Print #hFile, ribbonXML
Close hFile
End Sub
***IMPORTANT---- If you install the addin manually, make sure you select no when prompted if you want the file saved to the local machine. If you save it to the local machine, it creates a local copy, and will never update if you make changes to the network copy or need to fix an error.
There are more tips, but you'll mostly need to adapt them to fit how you operate. Hope that helps.

Handling save error messages using VBA

I have the following macro to auto save a workbook:
ActiveWorkbook.SaveAs Filename:=Workbooks(2).Path & "\" & ActiveWorkbook.Name
ActiveWorkbook.Close savechanges:=True
but the problem I have if the destination folder already has file with this name I get a message from Excel saying that this file already exists and whether I want to replace it.
What I need is the following:
if user selects Yes, then replace the existing file
if user selects No (currently I get a runtime error), then it saves it with V2 at the end of the file name, if this exists then V3 and so on
if user selects Cancel, then they see a message saying Are you sure you want to cancel. If they confirm then it's cancelled, otherwise it returns to the error message.
Or perhaps the code can be edited so that when it saves as it checks if file already exists in folder and if it does, then save it as v2.
You would probably have to refactor your current code to use it 'as-is' - but I think this is the logic that you are looking for:
Dim saveName As Variant
retry:
saveName = Application.GetSaveAsFileName
If Not saveName = False Then
If Len(Dir$(saveName)) = 0 Then
ActiveWorkbook.SaveAs saveName
Else
MsgBox "Workbook already exists, please choose a different name.", vbOkOnly
GoTo retry:
End If
Else
MsgBox "User cancelled save.", vbInformation"
End If
Something like
If Dir(strfilename) = "" Then
Else
strfilename=Application.GetSaveAsFilename
End If
ActiveWorkbook.SaveAs strfilename, XlFileFormat.xlOpenXMLWorkbookMacroEnabled

Excel, VBA, Macro, File - Open or Create, Dialog

I am writing a macro in MS excel using VBA. I need to open or create a file to write to.
Potentially the file may have a different extension (i.e. .cal) but internally it just contains text.
I have looked over a lot of examples that create a file by explicitly stating the path for the new file (here's one I found):
strFileName = "C:\test.txt"
Open strFileName For Output As #iFileNumber
Other examples open a file which already exists.
I would like to have a popup/dialog which allows the user to "either" open an existing file "or" create a new one. I assume this is possible.
I have played around with the Application.FileDialog(....) function using strings/paths and objects without much success so far.
With Application.FileDialog(...) your user should be able to create a new text file as they would in Windows Explorer (by right-clicking and selecting New->Text File), they can then select that file to output data to.
The below SelectFile(...) function returns the path to a selected file (or an empty string if no file was selected). Using this function as-is it is only possible for the user to select one file, but given the context I would hope this isn't a problem.
Public Sub SelectOrCreateFile()
Dim strFileName As String
Dim iFileNum As Integer
iFileNum = FreeFile
strFileName = SelectFile
If strFileName <> "" Then
Open strFileName For Output As #iFileNum
'### WRITE YOUR DATA ###
Close #iFileNum
End If
End Sub
'Returns File Path of file selected with file selection dialog
Public Function SelectFile(Optional DefaultPath As String = "", _
Optional FileType As String = "All Files", _
Optional FileExtension As String = "*.*") As String
Dim F As Object
Set F = Application.FileDialog(msoFileDialogFilePicker)
'Set up FileDialog properties
F.Filters.Clear
F.Filters.Add FileType, FileExtension
F.AllowMultiSelect = False
F.Title = "Select File"
F.ButtonName = "Select"
If DefaultPath <> "" Then F.InitialFileName = DefaultPath
'FileDialog.Show returns False if the user cancels
If F.show Then
SelectFile = F.SelectedItems(1)
Else
MsgBox "No File Selected", vbInformation, "Cancelled"
SelectFile = ""
End If
Set F = Nothing
End Function
Hope this helps!

Resources